[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