[Lazarus] (no subject)

Howard Page-Clark hdpc at talktalk.net
Sun Jul 31 14:11:49 CEST 2011


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




More information about the Lazarus mailing list