Przeciąganie elementu po ekranie

0

Hejka,
Mam jakiś obiekt - dajmy na to że Image - i chciałbym aby po kliknięciu i przytrzymaniu go przyciskiem myszki ten przesuwał się za kursorem do momentu upuszczenia w dowolnym miejscu. Jak mogę to zrobić w najprostszy sposób, ale tak aby nie przekombinować za bardzo?

Oczywiście wywołałem zdarzenie OnMouseMove, po czym próbowałem zrobić coś takiego:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift Then Begin
    Image1.Top := X;
    Image1.Left := Y;
  End;
end;

Ale efekt jest wręcz odrzucający, bo każde przesunięcie myszki o 1px nie resetuje wartości X i Y tylko sumuje je, a to w połączeniu z tym kodem sprawia, że po kilku px obrazek wyjeżdża poza okno.

Macie jakieś pomysły jak by to zrobić? Nie ukrywam, że największą satysfakcję przyniosłoby mi rozwiązanie tego z użyciem tylko jednego eventu. Im więcej kodu tym gorzej. :)

3

Nie możesz tak zrobić, bo argumenty X i Y określają pozycje kursora liczoną względem komponentu, nie ekranu; Punkt 0,0 jest lewym górnym rogiem komponentu Image1;

Masz małą podpowiedź:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  pntCursor: TPoint;
begin
  if ssLeft in Shift then
  begin
    { pobranie pozycji kursora względem ekranu }
    GetCursorPos(pntCursor);
    { obliczenie pozycji kursora względem formularza }
    pntCursor := ScreenToClient(pntCursor);
    { obliczenie nowej pozycji komponentu }
    Image1.Top := pntCursor.Y - (Image1.Height div 2);
    Image1.Left := pntCursor.X - (Image1.Width div 2);
  end;
end;

Dzięki temu podczas przesuwania kursor zawsze będzie na środku komponentu; Jeśli potrzebujesz innego efektu - wykonaj inne obliczenia.

1

W najprostszy sposób? Proszę bardzo. Dla komponentów mających uchwyt, takich jak Memo, Button, ListView:

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Memo1.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end; 

a dla nie mających uchwytu, np. Image, kładziemy komponent na panel (Panel1), ustawiamy Align komponentu na alClient i podobnie:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Panel1.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
 
0
marogo napisał(a)

W najprostszy sposób? Proszę bardzo. Dla komponentów mających uchwyt, takich jak Memo, Button, ListView

A owszem, jednak komponent klasy TImage nie posiada uchwytu (bo nie jest oknem), więc nie można doń wysyłać komunikatów za pomocą SendMessage czy PostMessage, dodawanie nowych komponentów z uchwytem tylko po to, by móc je przeciągać jest IMHO przerostem formy nad treścią :]

Ale dobrze, że napisałeś i o tym - będzie to uzupełnienie mojego postu, więc mamy komplet infomacji na temat przeciągania komponentów;

Swoją drogą jakiś czas temu opisywałem sposób na przeciąganie formularza z ustawionym BorderStyle na bsNone łapiąc za komponent klasy TImage - link do tego postu tutaj; Jednak tego sposobu nie można wykorzystać w przypadku TImage, bo nie ma uchwytu, więc trzeba ustawiać pozycję ręcznie.

0 użytkowników online, w tym zalogowanych: 0, gości: 0