How to see if two shapes overlap

I am trying to write a simple firemonkey test application.

I have a form with a panel (align: = alClient).
On form 2 TCircle . I set TCircle.Dragmode: = dmAutomatic.

I would like to drag circles around and something will happen when the circles overlap.
The question arises: I do not see any method in TCircle called overlap, and I do not see the event caused by the overlap. I tried all xxxxDrag events, but that does not help me with hittesting.

How can I see when a dragged shape overlays another shape?
I was expecting one of the DragOver events, DragEnter , to detect this for me, but this does not seem to be the case.

Surely there should be some standard method in Firemonkey?

Now the pas file looks like this:

 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; 

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 
+4
source share
5 answers

A common problem is complex and known as collision detection - you can use this term to search for related algorithms.

A special case of circle collision detection is simply to calculate the distance between the centers of the circles. If the distance obtained is less than the sum of the radii of the circle, the circles overlap.

+16
source

Despite the fact that this question is older than a year, I have recently encountered a similar problem. Thanks to a small amount of research in TRectF (used by FMX and FM2 Primitives), I got 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; 

It is not clear, but if two rectangles / objects intersect or overlap, then the result is correct.

An alternative is the same procedure, but the code is refined

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

You will need to work on it to accept some input objects (in my case, I used TSelection , known as Selection1 and Selection2) and maybe found a way to add an offset (see TControl.GetAbsoluteRect in FMX.Types ), but theoretically it should work with almost any primitive or any control.

As an additional note, there are many TRectF for such objects;

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

It is important to use the most appropriate for your situation (as the results will vary greatly in each case). In my example, TSelection were children of the form, so using AbsoluteRect was a very good choice (since LocalRect did not return the correct values).

Actually, you can scroll through each child component of your parent to be able to find out if there is a conflict between any and potentially, you could build a function that tells you which ones are facing (although this will probably require a recursive function) .

If you ever need to deal with “basic physics” in which collision detection is considered one (at least in this case, at a basic level) in Firemonkey, then working with TRectF is where you need to look. There’s a lot routines built into System.Types (XE3, and most likely XE2) automatically process this material, and as such you can avoid the large amount of math usually associated with this problem.

Additional notes

Something that I noticed was that the procedure described above was not very accurate and had several pixels. One solution is to put your shape in the parent container with alClient aligned, and then 5 pixels for all sides. Then, instead of measuring on TSelection.AbsoluteRect , the child AbsoluteRect is measured.

For example, I put a TCircle inside each TSelection, set the alignment of the circles to alClient , alClient to 5 on each side and a modified routine to work with Circle1 and Circle2 , unlike Selection1 and Selection2 . This turned out to be accurate to such an extent that if the circles themselves did not intersect (more precisely, their area did not overlap), then they would not be seen as colliding until the edges touch. Obviously, the angles of the circles themselves are a problem, but you could add another child component inside each circle, while its visibility is set to false, and it is slightly smaller in size to mimic the old collision method "Bounding Box" detection .

Application example

I added an example application with the source showing above. The 1 tab is a useful example, and the second tab gives a brief explanation of how TRectF works (and shows some limitations using the radar visual interface). The third tab demonstrates the use of TBitmapListAnimation to create animated images.

FMX Collision Detection - Example and Source

+1
source

It seems to me that there are too many possible permutations to easily solve this problem as a whole and effectively. In some special cases, there may be a simple and effective solution: for example, crossing the mouse cursor is simplified if you take into account only one point on the cursor; very good lap technique provided; Many regular shapes can also use custom collision detection formulas.

However, irregular shapes make the task difficult.

One option is to enclose each figure in an imaginary circle. If these circles overlap, you can imagine smaller, steeper circles in the vicinity of the original intersection. Repeat calculations with smaller and smaller circles as often as possible. This approach allows you to choose a compromise between processing requirements and detection accuracy.

The simplest and very general, albeit somewhat less effective, approach is to draw each shape on a screen canvas using solid colors and an xor mask. After drawing, if xor color pixels are found, this will mean a collision.

+1
source

So, the beginning / installation 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. 
+1
source

Guess what we need to minimize.

One option for this is the implementation of the 2D Hilbert-Johnson-Kirti distance algorithm .

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

0
source

All Articles