How to see if two shapes overlap

I'm trying to write a simple firemonkey test app.

I have a form, with a panel (align:= alClient).

On the form are 2 TCircle's. I have set TCircle.Dragmode:= dmAutomatic.

I would like to drag the circles around and have something happen when the circles overlap.

The question is: I don't see any method in TCircle called overlap, nor do I see an event called on overlap. I've tried all the xxxxDrag events, but that does not help me with the hittesting.

How can I see when a shape being dragged overlaps with another shape ?

I was expecting one of the DragOver, DragEnter events to detect this for me, but that does not seem to be the case.

Surely there must be some standard method for this in Firemonkey?

For now the pas file just looks like:

implementation

{$R *.fmx}

procedure TForm8.Circle1DragEnter(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
begin
  if Data.Source = Circle1 then Button1.Text:= 'DragEnter';

end;

procedure TForm8.Circle1DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Accept: Boolean);
begin
  if (Data.Source = Circle2) then Button1.Text:= 'Circle2 drag';
end;

procedure TForm8.Circle2DragEnd(Sender: TObject);
begin
  Button1.Text:= 'DragEnd';
end;

procedure TForm8.Circle2DragEnter(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
begin
  Button1.Text:= 'DragEnter';
end;

procedure TForm8.Circle2DragLeave(Sender: TObject);
begin
  Button1.Text:= 'DragLeave';
end;

procedure TForm8.Circle2DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Accept: Boolean);
begin
  if Data.Source = Circle2 then begin

    Button1.Text:= 'DragOver';
    Accept:= true;
  end;
end;

The dfm looks something like this:

object Form8: TForm8
  Left = 0
  Top = 0
  BiDiMode = bdLeftToRight
  Caption = 'Form8'
  ClientHeight = 603
  ClientWidth = 821
  Transparency = False
  Visible = False
  StyleLookup = 'backgroundstyle'
  object Panel1: TPanel
    Align = alClient
    Width = 821.000000000000000000
    Height = 603.000000000000000000
    TabOrder = 1
    object Button1: TButton
      Position.Point = '(16,16)'
      Width = 80.000000000000000000
      Height = 22.00000000开发者_Go百科0000000000
      TabOrder = 1
      StaysPressed = False
      IsPressed = False
      Text = 'Button1'
    end
    object Circle1: TCircle
      DragMode = dmAutomatic
      Position.Point = '(248,120)'
      Width = 97.000000000000000000
      Height = 105.000000000000000000
      OnDragEnter = Circle1DragEnter
      OnDragOver = Circle1DragOver
    end
    object Circle2: TCircle
      DragMode = dmAutomatic
      Position.Point = '(168,280)'
      Width = 81.000000000000000000
      Height = 65.000000000000000000
      OnDragEnter = Circle2DragEnter
      OnDragLeave = Circle2DragLeave
      OnDragOver = Circle2DragOver
      OnDragEnd = Circle2DragEnd
    end
  end
end

---

The general problem is difficult and known as collision detection - you can google the term to find the related algorithms.

The particular case of circles collision detection is easy - just calculate a distance between the centers of the circles. If the distance obtained is less than the sum of the circle's radii, the circles overlap.

---

Although this question is over a year old, i was facing a similar problem recently. Thanks to a bit of research into TRectF (used by FMX and FM2 Primitives), i came up with the following very simple function;

var
 aRect1, aRect2 : TRectF;
begin
  aRect1 := Selection1.AbsoluteRect;
  aRect2 := Selection2.AbsoluteRect;
  if System.Types.IntersectRect(aRect1,aRect2) then Result := True else Result := False;
end;

Self-explanatory, but if the 2 rectangles/objects intersect or overlap, then the result is true.

Alternative - Same routine, but code refined

var
 aRect1, aRect2 : TRectF;
begin
  aRect1 := Selection1.AbsoluteRect;
  aRect2 := Selection2.AbsoluteRect;
  result := System.Types.IntersectRect(aRect1,aRect2);
end;

You'll need to work on it to accept some input objects (in my case, i used TSelection's known as Selection1 and Selection2) and perhaps find a way to add an offset (take a look at TControl.GetAbsoluteRect in FMX.Types), but theoretically it should work with just about any primitive or any control.

Just as an additional note, there are numerous TRectF's in use for objects like this;

• AbsoluteRect
• BoundsRect
• LocalRect
• UpdateRect (May not apply to this situation, investigation needed)
• ParentedRect
• ClipRect
• ChildrenRect

It's important to use the one most appropriate to your situation (as results will vary wildly in each case). In my example, the TSelection's were children of the form so using AbsoluteRect was very much the best choice (as LocalRect didn't return the correct values).

Realistically, you could loop through each child component of your parent to be able to figure out if there's collision between any and potentially, you could build a function that tells you exactly which ones are colliding (though to do so would likely require a recursive function).

If you ever need to deal with "basic physics" under which Collision Detection would be considered one (at least in this case, it's at the basic level) in Firemonkey, then dealing with TRectF is where you need to look. There's a lot of routines built into System.Types (XE3 and likely XE2) to deal with this stuff automatically and as such you can avoid a lot of math commonly associated with this problem.

Further Notes

Something i noted was that the routine above wasn't very precise and was several pixels out. One solution is to put your shape inside a parent container with alClient alignment, and then 5 pixel padding to all sides. Then, instead of measuring on the TSelection.AbsoluteRect, measure on the child object's AbsoluteRect.

For example, i put a TCircle inside each TSelection, set the circles alignments to alClient, padding to 5 on each side, and the modified the routine to work with Circle1 and Circle2 as opposed to Selection1 and Selection2. This turned out to be precise to the point that if the circles themselves didn't overlap (or rather, their area didn't overlap), then they'd not be seen as colliding until the edges actually touched. Obviously, the corners of the circles themselves are a problem, but you could perhaps add another child component inside each circle with it's visibility set to false, and it being slightly smaller in dimensions so as to imitate the old "Bounding Box" method of collision detection.

Example Application

I've added an example application with source showing the above. 1 tab provides a usable example, while a second tab provides a brief explanation of how TRectF works (and shows some of the limitations through the use of a radar-like visual interface. There's a third tab that demonstrates use of TBitmapListAnimation to create animated images.

FMX Collision Detection - Example and Source

---

It seems to me that there are far too many possible permutations to easily solve this problem generically and efficiently. Some special cases may have a simple and efficient solution: E.g. mouse cursor intersection is simplified by only considering a single point on the cursor; a very good technique for circles has been provided; many regular shapes may also benefit from custom formulae to detect collision.

However, irregular shapes make the problem much more difficult.

One option would be to enclose each shape in an imaginary circle. If those circles overlap, you can then imagine smaller tighter circles in the vicinity of the original intersection. Repeat the calculations with smaller and smaller circles as often as desired. This approach will allow you to choose a trade-off between processing requirements and accuracy of the detection.

A simpler and very generic - though somewhat less efficient approach would be to draw each shape to an off-screen canvas using solid colours and an xor mask. After drawing, if any pixels of the xor colour are found, this would indicate a collision.

---

Hereby a begin/setup for collision-detection between TCircle, TRectangle and TRoundRect:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Objects, Generics.Collections, Math;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Circle1: TCircle;
    Circle2: TCircle;
    Rectangle1: TRectangle;
    Rectangle2: TRectangle;
    RoundRect1: TRoundRect;
    RoundRect2: TRoundRect;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Panel1DragOver(Sender: TObject; const Data: TDragObject;
      const Point: TPointF; var Accept: Boolean);
    procedure Panel1DragDrop(Sender: TObject; const Data: TDragObject;
      const Point: TPointF);
  private
    FShapes: TList<TShape>;
    function CollidesWith(Source: TShape; const SourceCenter: TPointF;
      out Target: TShape): Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

function Radius(AShape: TShape): Single;
begin
  Result := Min(AShape.ShapeRect.Width, AShape.ShapeRect.Height) / 2;
end;

function TForm1.CollidesWith(Source: TShape; const SourceCenter: TPointF;
  out Target: TShape): Boolean;
var
  Shape: TShape;
  TargetCenter: TPointF;

  function CollidesCircleCircle: Boolean;
  begin
    Result :=
      TargetCenter.Distance(SourceCenter) <= (Radius(Source) + Radius(Target));
  end;

  function CollidesCircleRectangle: Boolean;
  var
    Dist: TSizeF;
    RHorz: TRectF;
    RVert: TRectF;
  begin
    Dist.cx := Abs(TargetCenter.X - SourceCenter.X);
    Dist.cy := Abs(TargetCenter.Y - SourceCenter.Y);
    RHorz := Target.ShapeRect;
    RHorz.Offset(Target.ParentedRect.TopLeft);
    RVert := RHorz;
    RHorz.Inflate(Radius(Source), 0);
    RVert.Inflate(0, Radius(Source));
    Result := RHorz.Contains(SourceCenter) or RVert.Contains(SourceCenter) or
      (Sqr(RVert.Width / 2 - Dist.cx) + Sqr(RHorz.Height / 2 - Dist.cy) <= 
        Sqr(Radius(Source)));
  end;

  function CollidesRectangleCircle: Boolean;
  var
    Dist: TSizeF;
    RHorz: TRectF;
    RVert: TRectF;
  begin
    Dist.cx := Abs(TargetCenter.X - SourceCenter.X);
    Dist.cy := Abs(TargetCenter.Y - SourceCenter.Y);
    RHorz := Source.ShapeRect;
    RHorz.Offset(Source.ParentedRect.TopLeft);
    RHorz.Offset(SourceCenter.Subtract(Source.ParentedRect.CenterPoint));
    RVert := RHorz;
    RHorz.Inflate(Radius(Target), 0);
    RVert.Inflate(0, Radius(Target));
    Result := RHorz.Contains(TargetCenter) or RVert.Contains(TargetCenter) or
      (Sqr(RVert.Width / 2 - Dist.cx) + Sqr(RHorz.Height / 2 - Dist.cy) <= 
        Sqr(Radius(Target)));
  end;

  function CollidesRectangleRectangle: Boolean;
  var
    Dist: TSizeF;
  begin
    Dist.cx := Abs(TargetCenter.X - SourceCenter.X);
    Dist.cy := Abs(TargetCenter.Y - SourceCenter.Y);
    Result := 
      (Dist.cx <= (Source.ShapeRect.Width + Target.ShapeRect.Width) / 2) and
      (Dist.cy <= (Source.ShapeRect.Height + Target.ShapeRect.Height) / 2); 
  end;

  function CollidesCircleRoundRect: Boolean;
  var
    Dist: TSizeF;
    R: TRectF;
  begin
    Dist.cx := Abs(TargetCenter.X - SourceCenter.X);
    Dist.cy := Abs(TargetCenter.Y - SourceCenter.Y);
    R := Target.ShapeRect;
    R.Offset(Target.ParentedRect.TopLeft);
    if R.Width > R.Height then
    begin
      Dist.cx := Dist.cx - (R.Width - R.Height) / 2;
      R.Inflate(-Radius(Target), Radius(Source));
    end
    else
    begin
      Dist.cy := Dist.cy - (R.Height - R.Width) / 2;
      R.Inflate(Radius(Source), -Radius(Target));
    end;
    Result := R.Contains(SourceCenter) or
      (Sqrt(Sqr(Dist.cx) + Sqr(Dist.cy)) <= (Radius(Source) + Radius(Target)));
  end;

  function CollidesRoundRectCircle: Boolean;
  var
    Dist: TSizeF;
    R: TRectF;
  begin
    Dist.cx := Abs(TargetCenter.X - SourceCenter.X);
    Dist.cy := Abs(TargetCenter.Y - SourceCenter.Y);
    R := Source.ShapeRect;
    R.Offset(Source.ParentedRect.TopLeft);
    R.Offset(SourceCenter.Subtract(Source.ParentedRect.CenterPoint));
    if R.Width > R.Height then
    begin
      Dist.cx := Dist.cx - (R.Width - R.Height) / 2;
      R.Inflate(-Radius(Source), Radius(Target));
    end
    else
    begin
      Dist.cy := Dist.cy - (R.Height - R.Width) / 2;
      R.Inflate(Radius(Target), -Radius(Source));
    end;
    Result := R.Contains(TargetCenter) or
      (Sqrt(Sqr(Dist.cx) + Sqr(Dist.cy)) <= (Radius(Source) + Radius(Target)));
  end;

  function CollidesRectangleRoundRect: Boolean;
  begin
    Result := False;
  end;

  function CollidesRoundRectRectangle: Boolean;
  begin
    Result := False;
  end;

  function CollidesRoundRectRoundRect: Boolean;
  begin
    Result := False;
  end;

  function Collides: Boolean;
  begin
    if (Source is TCircle) and (Target is TCircle) then
      Result := CollidesCircleCircle
    else if (Source is TCircle) and (Target is TRectangle) then
      Result := CollidesCircleRectangle
    else if (Source is TRectangle) and (Target is TCircle) then
      Result := CollidesRectangleCircle
    else if (Source is TRectangle) and (Target is TRectangle) then
      Result := CollidesRectangleRectangle
    else if (Source is TCircle) and (Target is TRoundRect) then
      Result := CollidesCircleRoundRect
    else if (Source is TRoundRect) and (Target is TCircle) then
      Result := CollidesRoundRectCircle
    else if (Source is TRectangle) and (Target is TRoundRect) then
      Result := CollidesRectangleRoundRect
    else if (Source is TRoundRect) and (Target is TRectangle) then
      Result := CollidesRoundRectRectangle
    else if (Source is TRoundRect) and (Target is TRoundRect) then
      Result := CollidesRoundRectRoundRect
    else
      Result := False;
  end;

begin
  Result := False;
  for Shape in FShapes do
  begin
    Target := Shape;
    TargetCenter := Target.ParentedRect.CenterPoint;
    Result := (Target <> Source) and Collides;
    if Result then
      Break;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FShapes := TList<TShape>.Create;
  FShapes.AddRange([Circle1, Circle2, Rectangle1, Rectangle2, RoundRect1,
    RoundRect2]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FShapes.Free;
end;

procedure TForm1.Panel1DragDrop(Sender: TObject; const Data: TDragObject;
  const Point: TPointF);
var
  Source: TShape;
begin
  Source := TShape(Data.Source);
  Source.Position.Point := PointF(Point.X - Source.Width / 2,
    Point.Y - Source.Height / 2);
end;

procedure TForm1.Panel1DragOver(Sender: TObject; const Data: TDragObject;
  const Point: TPointF; var Accept: Boolean);
var
  Source: TShape;
  Target: TShape;
begin
  Source := TShape(Data.Source);
  if CollidesWith(Source, Point, Target) then
    Caption :=  Format('Kisses between %s and %s', [Source.Name, Target.Name])
  else
    Caption := 'No love';
  Accept := True;
end;

end.

---

Guess we have to roll our own.

One option for this is a 2D implementation of the Gilbert-Johnson-Keerthi distance algorithm.

A D implementation can be found here: http://code.google.com/p/gjkd/source/browse/