How to see if two shapes overlap - delphi

Question

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.000000000000000000
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

Answer 1

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.

Answer 2

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

Answer 3

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.

Answer 4

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.

Answer 5

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/