[Lazarus] (no subject)
Leonardo M. Ramé
l.rame at griensu.com
Sun Jul 31 17:56:02 CEST 2011
On 2011-07-31 13:11:49 +0100, Howard Page-Clark wrote:
> On 30/7/11 11:15, Leonardo Rame wrote:
> >Hi, I would like to drag the mouse over a form, while the mouse is
> >dragged, FPos X and Y values must change in the direction of the move,
> >but the mouse cursor must be fixed at the position where the first click
> >was made.
> >
> >This code does more or less what I want, but has two problems:
> >
> >1 - The mouse still moves a little.
> >2 - The values of FPos.X and FPos.Y doesn't change.
>
> >
> >procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
> > Y: Integer);
> >begin
> > if ssLeft in shift then
> > begin
> > Mouse.CursorPos := ClientToScreen(FPos);
> > FPos.X := X;
> > FPos.Y := Y;
> > Invalidate;
> > end;
> >end;
>
> Changing the mouse cursor position interferes with the Invalidate call. Try
> this:
>
> unit Unit1;
>
> {$mode objfpc}{$H+}
>
> interface
>
> uses
> Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
> windows;
>
> type
>
> { TForm1 }
>
> TForm1 = class(TForm)
> Label1: TLabel;
> procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
> Shift: TShiftState; X, Y: Integer);
> procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
> Integer);
> procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
> Shift: TShiftState; X, Y: Integer);
> procedure FormPaint(Sender: TObject);
> private
> FPos: TPoint;
> FOldCursorPos: TPoint;
> FOldCursor: TCursor;
> end;
>
> var
> Form1: TForm1;
>
> implementation
>
> {$R *.lfm}
>
> { TForm1 }
>
> procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
> Shift: TShiftState; X, Y: Integer);
> begin
> if ssleft in shift then
> begin
> FPos.X := X;
> FPos.Y := Y;
> FOldCursorPos:= FPos;
> FOldCursor := Cursor;
> Cursor := crNone;
> end;
> end;
>
> procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
> Y: Integer);
> begin
> if ssLeft in shift then
> begin
> //Mouse.CursorPos := ClientToScreen(FPos);
> FPos.X := X;
> FPos.Y := Y;
> Invalidate;
> end;
> end;
>
> procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
> Shift: TShiftState; X, Y: Integer);
> begin
> Cursor := FOldCursor;
> end;
>
> procedure TForm1.FormPaint(Sender: TObject);
> var
> HCursor : THandle;
> begin
> Label1.Caption := Format('X: %d - Y: %d', [FPos.X, FPos.Y]);
> HCursor := Screen.Cursors[Ord(Screen.Cursor)];
> DrawIconEx(Canvas.Handle,
> FOldCursorPos.X, FOldCursorPos.y, HCursor, 32, 32, 0, 0, DI_NORMAL) ;
> end;
>
> end.
>
> It is only a solution for Windows, and it does not remove the 'permanent'
> cursor until a second click, but it should get you on the right path.
>
> Howard
I tried this on Linux, with a slightly modified FormPaint event handler,
but the effect is the same as in my example.
When I move the mouse, FPos is changed to the new values of X and Y, but
when Mouse.CursorPos is called using FOldCursorPos as new position,
OnMouseMove is called again, and FPos is changed again to its old position.
Here's my new code:
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssleft in shift then
begin
FPos.X := X;
FPos.Y := Y;
FOldCursorPos:= FPos;
Cursor := crNone;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in shift then
begin
FPos.X := X;
FPos.Y := Y;
Invalidate;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Cursor := crDefault;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
Label1.Caption := Format('X: %d - Y: %d', [FPos.X, FPos.Y]);
Mouse.CursorPos := ClientToScreen(FOldCursorPos);
end;
--
Leonardo M. Ramé
http://leonardorame.blogspot.com
More information about the Lazarus
mailing list