Dragging Rectangles on Firemonkey Form

Delphi DX10 

For the perennial question of how to move objects around the form at run time, here is a method for dragging Rectangles (or any shapes) around on the form with the mouse or touch.

Considerations:

We need a Layout in the background to use as a coordinate system that can be turned on and off. 

We need to set Rectangle.Hittest:= true so we can pick it.

We need to set Layout.Hittest := false to start with or it will interfere with picking the rectangles.

When we pick a rectangle, we need to capture the mouse events of the Layout so we can use the coordinates MouseMove and MouseUp to stop. We will do this with Layout1.Root.Captured := Layout1;

Use the Layout X,Y MouseMove coordinates to move rectangle.

Use Layout MouseUp event to end dragging. Layout mouse capture is turned off and we can pick the next rectangle.


unit File: Mainunit.pas

unit Mainunit;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Layouts, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TMainForm = class(TForm)
    Layout1: TLayout;
    Rectangle1: TRectangle;
    procedure Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure Layout1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.fmx}

const
  MAX_RECTANGLES = 10;
  RECT_WIDTH = 80;
  RECT_HEIGHT = 80;

var
  Grab: boolean = false;
  Offset: tpointf;
  MovingRectangle: TRectangle;
  RectArray: array [0 .. MAX_RECTANGLES] of TRectangle;

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: integer;
  TitleRect: TRectangle;
  TitleLabel: TLabel;
begin
  Layout1.HitTest := false; // want to pick rectangles
  for I := Low(RectArray) to high(RectArray) do
  begin
    RectArray[I] := TRectangle.Create(self);
    RectArray[I].Parent := Layout1;
    RectArray[I].OnMouseDown := Rectangle1MouseDown;
    RectArray[I].OnMouseUp := Layout1MouseUp;
    RectArray[I].Width := RECT_WIDTH;
    RectArray[I].Height := RECT_HEIGHT;
    RectArray[I].fill.Color := random($FFFFFF) or $FF000000;
    RectArray[I].Position.X := random(trunc(Layout1.Width - RECT_WIDTH));
    RectArray[I].Position.Y := random(trunc(Layout1.Height - RECT_HEIGHT));

    TitleRect := TRectangle.Create(self);
    TitleRect.fill.Color := Talphacolorrec.White;
    TitleRect.Position.X := 0;
    TitleRect.Position.Y := 0;
    TitleRect.Width := RECT_WIDTH;
    TitleRect.Height := 16;
    TitleRect.HitTest := false;

    TitleLabel := TLabel.Create(self);
    TitleLabel.StyledSettings:=[];
    TitleLabel.Font.Size:=12;
    TitleLabel.Text := 'Caption ' + I.ToString;
    TitleRect.AddObject(TitleLabel);

    RectArray[I].AddObject(TitleRect);
  end;
end;

procedure TMainForm.Layout1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if Grab and (ssleft in Shift) then
  begin
    // keep from dragging off Layout
    if X > (Layout1.Width + Offset.X - RECT_WIDTH) then
      X := Layout1.Width + Offset.X - RECT_WIDTH;
    if Y > (Layout1.Height + Offset.Y - RECT_HEIGHT) then
      Y := Layout1.Height + Offset.Y - RECT_HEIGHT;
    if X < Offset.X then
      X := Offset.X;
    if Y < Offset.Y then
      Y := Offset.Y;

    MovingRectangle.Position.X := X - Offset.X;
    MovingRectangle.Position.Y := Y - Offset.Y;
  end;
end;

procedure TMainForm.Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  Grab := false;
  // MouseUp automatically turns off mouse capture of Layout1
end;

procedure TMainForm.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Single);
begin
  MovingRectangle := Sender as TRectangle;
  Offset.X := X;
  Offset.Y := Y;
  // sets mouse capture to Layout1
  Layout1.Root.Captured := Layout1;
  MovingRectangle.BringToFront; // optional
  MovingRectangle.Repaint;
  Grab := true;
end;

end.


FMX File: Mainunit.FMX

object MainForm: TMainForm
  Left = 0
  Top = 0
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = Single
  Caption = 'Form33'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignerMasterStyle = 0
  object Layout1: TLayout
    Anchors = [akLeft, akTop, akRight, akBottom]
    HitTest = False    
    Position.X = 30.000000000000000000
    Position.Y = 30.000000000000000000
    Size.Width = 579.000000000000000000
    Size.Height = 421.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 0
    OnMouseMove = Layout1MouseMove
    OnMouseUp = Layout1MouseUp
    object Rectangle1: TRectangle
      Align = Client
      Fill.Color = claAntiquewhite
      HitTest = False
      Size.Width = 579.000000000000000000
      Size.Height = 421.000000000000000000
      Size.PlatformDefault = False
    end
  end
end


DPR File:
program DragRectangles;

uses
  System.StartUpCopy,
  FMX.Forms,
  Mainunit in 'Mainunit.pas' {MainForm};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := DebugHook <> 0;
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.




Works in Windows, OSX, IOS, Android

Download DX10 Source code: DragRectangles.zip

Form Shown on Screens:





You can test when the rectangle you are moving lands on top of another one.
Just replace the TMainForm.Layout1MouseUp procedure with this one:

procedure TMainForm.Layout1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  I: integer;
  BottomRectangle: TRectangle;

  function PointInRect(X, Y { top rect corner coords in layout1 } : Single; BotRect: TRectangle): boolean;
  begin
    if (X >= BotRect.Position.X) and (X <= (BotRect.Position.X + BotRect.Width)) and (Y >= BotRect.Position.Y)
      and (Y <= BotRect.Position.Y + BotRect.Height) then
      result := true
    else
      result := false;
  end;

  function RectangleOnTop(TopRect, BotRect: TRectangle): boolean;
  var
    X1, Y1, X2, Y2, X3, Y3, X4, Y4: Single;
  begin
    // 4 corners
    // 1-------2
    // 3-------4
    result := false;
    X1 := TopRect.Position.X; // these are the four corners according in layout1 coords
    Y1 := TopRect.Position.Y; // of the top moving rect
    X2 := X1 + TopRect.Width;
    Y2 := Y1;
    X3 := X1;
    Y3 := Y1 + TopRect.Height;
    X4 := X2;
    Y4 := Y3;

    // check 4 corners of top rect
    if PointInRect(X1, Y1, BotRect) or PointInRect(X2, Y2, BotRect) or PointInRect(X3, Y3, BotRect) or
      PointInRect(X4, Y4, BotRect) then
      result := true;
  end;

begin
  Grab := false;
  // MouseUp automatically turns off mouse capture of Layout1

  // check to see if over another rectangle
  for I := Low(RectArray) to high(RectArray) do
  begin
    if MovingRectangle <> RectArray[I] then
    begin
      if RectangleOnTop(MovingRectangle, RectArray[I]) then
      begin
        BottomRectangle := RectArray[I];
        beep;
        showmessage('Over Rect ' + TLabel(BottomRectangle.Children.Items[0].Children.Items[0]).Text);
        break;
      end;
    end;
  end;
end;