How to move any component at runtime (Views: 31)
Problem/Question/Abstract: 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: procedure TForm1.MoveControl(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TempPanel: TPanel; Control: TControl; begin {Release the MOUSEDOWN status} ReleaseCapture; {If the component is a TWinControl, just move it directly} if Sender is TWinControl then TWinControl(Sender).Perform(WM_SysCommand, $F012, 0) else try Control := TControl(Sender); TempPanel := TPanel.Create(Self); with TempPanel do begin {Replace the component with TempPanel} Caption := ''; BevelOuter := bvNone; SetBounds(Control.Left, Control.Top, Control.Width, Control.Height); Parent := Control.Parent; {Put our control in TempPanel} Control.Parent := TempPanel; {Move TempPanel with control inside of it} Perform(WM_SysCommand, $F012, 0); {Put the component where the panel was dropped} Control.Parent := Parent; Control.Left := Left; Control.Top := Top; end; finally TempPanel.Free; end; end; Solve 2: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TControlDragKind = (dkNone, dkTopLeft, dkTop, dkTopRight, dkRight, dkBottomRight, dkBottom, dkBottomLeft, dkLeft, dkClient); TForm1 = class(TForm) procedure FormClick(Sender: TObject); private { Private declarations } FDownPos: TPoint; { position of last mouse down, screen-relative } FDragKind: TcontrolDragKind; { kind of drag in progress } procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function GetDragging: Boolean; public { Public declarations } property DraggingControl: Boolean read GetDragging; end; var Form1: TForm1; implementation {$R *.DFM} const { Set of cursors to use while moving over and dragging on controls. } DragCursors: array[TControlDragKind] of TCursor = (crDefault, crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE, crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE, crHandPoint); {Width of "hot zone" for dragging around the control borders. } HittestMargin = 3; type TCracker = class(TControl); { Needed since TControl.MouseCapture is protected } { Perform hittest on the mouse position. Position is in client coordinates for the passed control. } function GetDragKind(control: TControl; X, Y: Integer): TControlDragKind; var r: TRect; begin r := control.Clientrect; Result := dkNone; if Abs(X - r.left) <= HittestMargin then if Abs(Y - r.top) <= HittestMargin then Result := dkTopLeft else if Abs(Y - r.bottom) <= HittestMargin then Result := dkBottomLeft else Result := dkLeft else if Abs(X - r.right) <= HittestMargin then if Abs(Y - r.top) <= HittestMargin then Result := dkTopRight else if Abs(Y - r.bottom) <= HittestMargin then Result := dkBottomRight else Result := dkRight else if Abs(Y - r.top) <= HittestMargin then Result := dkTop else if Abs(Y - r.bottom) <= HittestMargin then Result := dkBottom else if PtInRect(r, Point(X, Y)) then Result := dkClient; end; procedure TForm1.FormClick(Sender: TObject); var pt: TPoint; begin {get cursor position, convert to client coordinates} GetCursorPos(pt); pt := ScreenToClient(pt); {create label with top left corner at mouse position} with TLabel.Create(Self) do begin Autosize := False; { Otherwise resizing is futile. } SetBounds(pt.x, pt.y, width, height); Caption := Format('Hit at %d, %d', [pt.x, pt.y]); Color := clBlue; Font.Color := clWhite; Parent := Self; {attach the drag handlers} OnMouseDown := ControlMouseDown; OnMouseUp := ControlMouseUp; OnMouseMove := ControlMouseMove; end; end; procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { Go into drag mode if left mouse button went down and no modifier key is pressed. } if (Button = mbLeft) and (Shift = [ssLeft]) then begin { Determine where on the control the mouse went down. } FDragKind := GetDragKind(Sender as TControl, X, Y); if FDragKind <> dkNone then begin with TCracker(Sender) do begin { Record current position screen-relative, the origin for the client-relative position will move if the form is moved or resized on left/top sides. } FDownPos := ClientToScreen(Point(X, Y)); MouseCapture := True; Color := clRed; end; end; end; end; procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var dx, dy: Integer; pt: TPoint; r: TRect; begin { Set controls cursor depending on position in control. } (Sender as TControl).Cursor := DragCursors[GetDragKind(TControl(Sender), X, Y)]; { If we are dragging the control, get amount the mouse has moved since last call and calculate a new boundsrect for the control from it, depending on drag mode. } if DraggingControl then with Sender as TControl do begin pt := ClientToScreen(Point(X, Y)); dx := pt.X - FDownPos.X; dy := pt.Y - FDownPos.Y; { Update stored mouse position to current position. } FDownPos := pt; r := BoundsRect; case FDragKind of dkTopLeft: begin r.Left := r.Left + dx; r.Top := r.Top + dy; end; dkTop: begin r.Top := r.Top + dy; end; dkTopRight: begin r.Right := r.Right + dx; r.Top := r.Top + dy; end; dkRight: begin r.Right := r.Right + dx; end; dkBottomRight: begin r.Right := r.Right + dx; r.Bottom := r.Bottom + dy; end; dkBottom: begin r.Bottom := r.Bottom + dy; end; dkBottomLeft: begin r.Left := r.Left + dx; r.Bottom := r.Bottom + dy; end; dkLeft: begin r.Left := r.Left + dx; end; dkClient: begin OffsetRect(r, dx, dy); end; end; { Don't let the control be resized to nothing } if ((r.right - r.left) > 2 * HittestMargin) and ((r.bottom - r.top) > 2 * HittestMargin) then Boundsrect := r; end; end; procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if DraggingControl then begin { Revert to non-dragging state. } FDragKind := dkNone; with TCracker(Sender) do begin MouseCapture := False; Color := clBlue; end; end; end; { Read method for ControlDragging property, returns true if form is in drag mode. } function TForm1.GetDragging: Boolean; begin Result := FDragKind <> dkNone; end; end. Solve 3: unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } LastX, LastY: Integer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin with (Sender as TPanel) do begin if csLButtonDown in ControlState then begin Left := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X, ClientToScreen(Point(Left, Top)).Y)).X + (X - LastX); Top := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X, ClientToScreen(Point(Left, Top)).Y)).Y + (Y - LastY); end; end; end; procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin LastX := X; LastY := Y; end; end. |