Mega Code Archive
Moving objects with snapgrid functionality
<![CDATA[
Title: Moving objects with snapgrid functionality
Question: Here's an object that enables you to move your objects on a form easily during runtime...
Answer:
TObjectMover = class(TObject)
Private
{ Private declarations }
MousePosInfo : TPoint;
CurrentObject : TControl;
WindowHandle : THandle;
fSnapGrid : Integer;
Procedure WndProc(var Msg: TMessage);
Protected
{ Protected declarations }
Public
{ Public declarations }
Constructor Create;
Destructor Destroy; override;
Function BeginMove(Obj: TControl) : Boolean;
Published
{ Published declarations }
Property SnapGrid : Integer read fSnapGrid write fSnapGrid;
End;
Constructor TObjectMover.Create;
Begin
Inherited Create;
WindowHandle := AllocateHwnd(WndProc);
fSnapGrid := 8;
MousePosInfo := Point(0, 0);
CurrentObject := NIL;
End;
Destructor TObjectMover.Destroy;
Begin
DeallocateHwnd(WindowHandle);
Inherited Destroy;
End;
Function TObjectMover.BeginMove(Obj: TControl) : Boolean;
Begin
Result := False;
IF (Assigned(Obj)) Then
Begin
IF (Assigned(Obj.Parent)) Then
Begin
Result := True;
CurrentObject := Obj;
MousePosInfo := CurrentObject.ScreenToClient(Mouse.CursorPos);
CurrentObject.BringToFront;
SetCapture(WindowHandle);
End;
End;
End;
Procedure TObjectMover.WndProc(var Msg: TMessage);
Var
P : TPoint;
Begin
IF (Msg.Msg = WM_MouseMove) Then
Begin
IF (Assigned(CurrentObject)) Then
Begin
P := Mouse.CursorPos;
P := CurrentObject.Parent.ScreenToClient(P);
Dec(P.x, MousePosInfo.x);
Dec(P.y, MousePosInfo.y);
CurrentObject.Left := P.x - (P.x mod fSnapGrid);
CurrentObject.Top := P.y - (P.y mod fSnapGrid);
End;
End;
IF (Msg.Msg = WM_LBUTTONUP) Then
Begin
IF (Assigned(CurrentObject)) Then
Begin
CurrentObject := NIL;
ReleaseCapture;
End;
End;
End;
To test the new object:
Procedure TForm1.FormCreate(Sender: TObject);
Begin
ObjectMover := TObjectMover.Create;
End;
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
ObjectMover.Free;
End;
Procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
IF (not ObjectMover.BeginMove(ListBox1)) Then ShowMessage('Failed to move object!');
End;
]]>