[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