[Lazarus] Drag (and show) images
Giuliano Colla
giuliano.colla at fastwebnet.it
Fri Apr 13 10:45:42 CEST 2018
Il 13/04/2018 02:40, Donald Ziesig via Lazarus ha scritto:
> You're right. It gets *close* but not quite there. I can move the
> control so long as the mouse is *not* over the control while it is
> moving :-(. I will look at this closer in the morning and see if I can
> work around it (or if there is something I am missing).
>
You might find useful, as a guideline, the code I'm using in one of my
application to drag a button so that it doesn't cover the useful part of
an image. Just using the OnMouseDown, OnMouseMove and OnMouseUp of your
TImage, and getting rid of the code you don't need, to perform an extra
action on OnMouseUp, you should be able to do the trick.
> TErrForm = class(TForm)
> ......
> protected
> ResetDragged: Boolean;
> CursorPos: TPoint;
> ObjectPos: TPoint;
> ....
>
> procedure TErrForm.ResetBtnMouseDown(Sender: TObject; Button:
> TMouseButton;
> Shift: TShiftState; X: LongInt; Y: LongInt);
> begin
> ResetDragged := True;
> CursorPos.X := Mouse.CursorPos.X;
> CursorPos.Y := Mouse.CursorPos.Y;
> with ResetBtn do begin;
> ObjectPos.X := Left;
> ObjectPos.Y := Top;
> end;
> end;
>
> procedure TErrForm.ResetBtnMouseMove(Sender: TObject; Shift: TShiftState;
> X: LongInt; Y: LongInt);
> begin
> if ResetDragged then begin
> with ResetBtn do begin
> Left := ObjectPos.X + (Mouse.CursorPos.X - CursorPos.X);
> Top := ObjectPos.Y + (Mouse.CursorPos.Y - CursorPos.Y);
> ResetPos.X := (Left * NormalGeometry.ClientWidth div
> CurrImage.Width) + HorzScrollBar.Position;
> ResetPos.Y := (Top * NormalGeometry.ClientHeight div
> CurrImage.Height) + VertScrollBar.Position;
> end;
> end;
> end;
>
> procedure TErrForm.ResetBtnMouseUp(Sender: TObject; Button: TMouseButton;
> Shift: TShiftState; X: LongInt; Y: LongInt);
> begin
> if ResetDragged then begin
> ResetDragged := False;
> Paint;
> end;
> if (abs(Mouse.CursorPos.X - CursorPos.X) < 10) and
> (abs(Mouse.CursorPos.Y - CursorPos.Y)< 10) then Close;
> end;
Hope that it helps.
Giuliano
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20180413/b8bc4097/attachment.html>
More information about the Lazarus
mailing list