How to move any component at runtime

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.