Author: Tomas Rutkauskas
How to move any component at runtime
Answer:
Solve 1:
There is a simple trick for allowing the user to move components at runtime.
However, this will only work for components which derive from a TWinControl as it
requires a Handle property. The solution I am about to give will work with ANY
component. Although it uses the same method, I have achieved moving components
without a handle property by temporarily placing them inside a TPanel. Make sure
ExtCtrls is in your USES clause, then point the OnMouseDown event for each
component at the following code:
1 procedure TForm1.MoveControl(Sender: TObject; Button: TMouseButton;
2 Shift: TShiftState; X, Y: Integer);
3 var
4 TempPanel: TPanel;
5 Control: TControl;
6 begin
7 {Release the MOUSEDOWN status}
8 ReleaseCapture;
9 {If the component is a TWinControl, just move it directly}
10 if Sender is TWinControl then
11 TWinControl(Sender).Perform(WM_SysCommand, $F012, 0)
12 else
13 try
14 Control := TControl(Sender);
15 TempPanel := TPanel.Create(Self);
16 with TempPanel do
17 begin
18 {Replace the component with TempPanel}
19 Caption := '';
20 BevelOuter := bvNone;
21 SetBounds(Control.Left, Control.Top, Control.Width, Control.Height);
22 Parent := Control.Parent;
23 {Put our control in TempPanel}
24 Control.Parent := TempPanel;
25 {Move TempPanel with control inside of it}
26 Perform(WM_SysCommand, $F012, 0);
27 {Put the component where the panel was dropped}
28 Control.Parent := Parent;
29 Control.Left := Left;
30 Control.Top := Top;
31 end;
32 finally
33 TempPanel.Free;
34 end;
35 end;
Solve 2:
36 unit Unit1;
37
38 interface
39
40 uses
41 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
42 StdCtrls;
43
44 type
45 TControlDragKind = (dkNone, dkTopLeft, dkTop, dkTopRight, dkRight, dkBottomRight,
46 dkBottom, dkBottomLeft, dkLeft, dkClient);
47
48 TForm1 = class(TForm)
49 procedure FormClick(Sender: TObject);
50 private
51 { Private declarations }
52 FDownPos: TPoint; { position of last mouse down, screen-relative }
53 FDragKind: TcontrolDragKind; { kind of drag in progress }
54 procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
55 Shift: TShiftState; X, Y: Integer);
56 procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
57 procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
58 Shift: TShiftState; X, Y: Integer);
59 function GetDragging: Boolean;
60 public
61 { Public declarations }
62 property DraggingControl: Boolean read GetDragging;
63 end;
64
65 var
66 Form1: TForm1;
67
68 implementation
69
70 {$R *.DFM}
71
72 const
73 { Set of cursors to use while moving over and dragging on controls. }
74 DragCursors: array[TControlDragKind] of TCursor =
75 (crDefault, crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE,
76 crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE, crHandPoint);
77 {Width of "hot zone" for dragging around the control borders. }
78 HittestMargin = 3;
79
80 type
81 TCracker = class(TControl); { Needed since TControl.MouseCapture is protected }
82
83 { Perform hittest on the mouse position. Position is in client coordinates for
84 the passed control. }
85
86 function GetDragKind(control: TControl; X, Y: Integer): TControlDragKind;
87 var
88 r: TRect;
89 begin
90 r := control.Clientrect;
91 Result := dkNone;
92 if Abs(X - r.left) <= HittestMargin then
93 if Abs(Y - r.top) <= HittestMargin then
94 Result := dkTopLeft
95 else if Abs(Y - r.bottom) <= HittestMargin then
96 Result := dkBottomLeft
97 else
98 Result := dkLeft
99 else if Abs(X - r.right) <= HittestMargin then
100 if Abs(Y - r.top) <= HittestMargin then
101 Result := dkTopRight
102 else if Abs(Y - r.bottom) <= HittestMargin then
103 Result := dkBottomRight
104 else
105 Result := dkRight
106 else if Abs(Y - r.top) <= HittestMargin then
107 Result := dkTop
108 else if Abs(Y - r.bottom) <= HittestMargin then
109 Result := dkBottom
110 else if PtInRect(r, Point(X, Y)) then
111 Result := dkClient;
112 end;
113
114 procedure TForm1.FormClick(Sender: TObject);
115 var
116 pt: TPoint;
117 begin
118 {get cursor position, convert to client coordinates}
119 GetCursorPos(pt);
120 pt := ScreenToClient(pt);
121 {create label with top left corner at mouse position}
122 with TLabel.Create(Self) do
123 begin
124 Autosize := False; { Otherwise resizing is futile. }
125 SetBounds(pt.x, pt.y, width, height);
126 Caption := Format('Hit at %d, %d', [pt.x, pt.y]);
127 Color := clBlue;
128 Font.Color := clWhite;
129 Parent := Self;
130 {attach the drag handlers}
131 OnMouseDown := ControlMouseDown;
132 OnMouseUp := ControlMouseUp;
133 OnMouseMove := ControlMouseMove;
134 end;
135 end;
136
137 procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
138 Shift: TShiftState; X, Y: Integer);
139 begin
140 { Go into drag mode if left mouse button went down and no modifier key is
141 pressed. }
142 if (Button = mbLeft) and (Shift = [ssLeft]) then
143 begin
144 { Determine where on the control the mouse went down. }
145 FDragKind := GetDragKind(Sender as TControl, X, Y);
146 if FDragKind <> dkNone then
147 begin
148 with TCracker(Sender) do
149 begin
150 { Record current position screen-relative, the origin for the
151 client-relative position will move if the form is moved or resized on left/top
152 sides. }
153 FDownPos := ClientToScreen(Point(X, Y));
154 MouseCapture := True;
155 Color := clRed;
156 end;
157 end;
158 end;
159 end;
160
161 procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
162 Integer);
163 var
164 dx, dy: Integer;
165 pt: TPoint;
166 r: TRect;
167 begin
168 { Set controls cursor depending on position in control. }
169 (Sender as TControl).Cursor := DragCursors[GetDragKind(TControl(Sender), X, Y)];
170 { If we are dragging the control, get amount the mouse has moved since last call
171 and calculate a new boundsrect for the control from it, depending on drag mode. }
172 if DraggingControl then
173 with Sender as TControl do
174 begin
175 pt := ClientToScreen(Point(X, Y));
176 dx := pt.X - FDownPos.X;
177 dy := pt.Y - FDownPos.Y;
178 { Update stored mouse position to current position. }
179 FDownPos := pt;
180 r := BoundsRect;
181 case FDragKind of
182 dkTopLeft:
183 begin
184 r.Left := r.Left + dx;
185 r.Top := r.Top + dy;
186 end;
187 dkTop:
188 begin
189 r.Top := r.Top + dy;
190 end;
191 dkTopRight:
192 begin
193 r.Right := r.Right + dx;
194 r.Top := r.Top + dy;
195 end;
196 dkRight:
197 begin
198 r.Right := r.Right + dx;
199 end;
200 dkBottomRight:
201 begin
202 r.Right := r.Right + dx;
203 r.Bottom := r.Bottom + dy;
204 end;
205 dkBottom:
206 begin
207 r.Bottom := r.Bottom + dy;
208 end;
209 dkBottomLeft:
210 begin
211 r.Left := r.Left + dx;
212 r.Bottom := r.Bottom + dy;
213 end;
214 dkLeft:
215 begin
216 r.Left := r.Left + dx;
217 end;
218 dkClient:
219 begin
220 OffsetRect(r, dx, dy);
221 end;
222 end;
223 { Don't let the control be resized to nothing }
224 if ((r.right - r.left) > 2 * HittestMargin) and ((r.bottom - r.top) > 2 *
225 HittestMargin) then
226 Boundsrect := r;
227 end;
228 end;
229
230 procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
231 Shift: TShiftState; X, Y: Integer);
232 begin
233 if DraggingControl then
234 begin
235 { Revert to non-dragging state. }
236 FDragKind := dkNone;
237 with TCracker(Sender) do
238 begin
239 MouseCapture := False;
240 Color := clBlue;
241 end;
242 end;
243 end;
244
245 { Read method for ControlDragging property, returns true if form is in drag mode. }
246
247 function TForm1.GetDragging: Boolean;
248 begin
249 Result := FDragKind <> dkNone;
250 end;
251
252 end.
Solve 3:
253 unit Unit1;
254
255 interface
256
257 uses
258 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
259 ExtCtrls;
260
261 type
262 TForm1 = class(TForm)
263 Panel1: TPanel;
264 procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
265 procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
266 Shift: TShiftState; X, Y: Integer);
267 private
268 { Private declarations }
269 LastX, LastY: Integer;
270 public
271 { Public declarations }
272 end;
273
274 var
275 Form1: TForm1;
276
277 implementation
278
279 {$R *.DFM}
280
281 procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
282 Integer);
283 begin
284 with (Sender as TPanel) do
285 begin
286 if csLButtonDown in ControlState then
287 begin
288 Left := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X,
289 ClientToScreen(Point(Left, Top)).Y)).X + (X - LastX);
290 Top := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X,
291 ClientToScreen(Point(Left, Top)).Y)).Y + (Y - LastY);
292 end;
293 end;
294 end;
295
296 procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
297 Shift: TShiftState; X, Y: Integer);
298 begin
299 LastX := X;
300 LastY := Y;
301 end;
302
303 end.
|
