如何查看两个形状是否重叠答案

【问题标题】：How to see if two shapes overlap如何查看两个形状是否重叠
【发布时间】：2011-10-02 20:00:49
【问题描述】：

我正在尝试编写一个简单的 firemonkey 测试应用程序。

我有一个带有面板的表单 (align:= alClient)。
表格上有 2 个TCircle。我已经设置了 TCircle.Dragmode:= dmAutomatic。

我想拖动圆圈并在圆圈重叠时发生一些事情。
问题是：我在 TCircle 中没有看到任何称为重叠的方法，也没有看到称为重叠的事件。我已经尝试了所有 xxxxDrag 事件，但这对我的命中测试没有帮助。

如何查看被拖动的形状何时与另一个形状重叠？
我期待DragOver、DragEnter 事件之一为我检测到这一点，但似乎并非如此。

在 Firemonkey 中肯定有一些标准的方法吗？

现在 pas 文件看起来像：

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 看起来像这样：

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

【问题讨论】：

是否允许使用像 CombineRgn 这样的 windows 函数，因为您的问题被标记为 firemonkey，这意味着您正在寻找独立于 windows 的解决方案？
您对哪种形状感兴趣？只有圆形、矩形、圆形矩形、椭圆和饼形，还是更多？
回应赏金的注释：鉴于问题的复杂性，FireMonkey 似乎不太可能提供比最基本和基本的命中测试更多的功能 - 如果有的话！寻找第三方游戏库可能会更好。
@CraigYoung，鉴于目标市场，firemonkey 支持这一点是有道理的，但我明白你的意思。

标签： delphi hittest delphi-xe2 firemonkey

【解决方案1】：

一般问题比较困难，被称为碰撞检测 - 您可以在谷歌上搜索该术语以找到相关算法。

圆碰撞检测的特殊情况很容易 - 只需计算圆心之间的距离。如果得到的距离小于圆的半径之和，则圆重叠。

【讨论】：

我希望 FireMonkey 会为我解决这个问题。
Firemonkey 不负责碰撞检测

【解决方案2】：

虽然这个问题已经有一年多了，但我最近也遇到了类似的问题。感谢对TRectF（FMX 和 FM2 Primitives 使用）的一些研究，我想出了以下非常简单的函数；

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

不言自明，但如果 2 个矩形/对象相交或重叠，则结果为真。

替代方案 - 相同的例程，但改进了代码

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

您需要对其进行处理以接受一些输入对象（在我的情况下，我使用了 TSelection 称为 Selection1 和 Selection2）并且可能找到添加偏移量的方法（看看 @987654326 @ in FMX.Types)，但理论上它应该适用于几乎任何原语或任何控件。

作为补充说明，有许多 TRectF 用于此类对象；

AbsoluteRect
BoundsRect
LocalRect
UpdateRect（可能不适用于这种情况，需要调查）
ParentedRect
ClipRect
ChildrenRect

使用最适合您的情况的方法很重要（因为每种情况下的结果都会有很大差异）。在我的示例中，TSelection 是表单的子级，因此使用 AbsoluteRect 是最好的选择（因为 LocalRect 没有返回正确的值）。

实际上，您可以遍历父组件的每个子组件，以确定是否存在任何潜在冲突，您可以构建一个函数来准确告诉您哪些子组件正在发生冲突（尽管这样做可能需要递归函数）。

如果您需要处理“基本物理”，在 Firemonkey 中碰撞检测将被视为一种（至少在这种情况下，它是基本级别），那么处理 TRectF 是您需要查看的地方. System.Types（XE3 和可能的 XE2）内置了很多例程来自动处理这些问题，因此您可以避免很多通常与此问题相关的数学运算。

补充说明

我注意到上面的例程不是很精确，而且有几个像素。一种解决方案是将您的形状放在具有alClient 对齐的父容器中，然后在所有边上填充 5 像素。然后，不是在TSelection.AbsoluteRect 上进行测量，而是在子对象的AbsoluteRect 上进行测量。

例如，我在每个 TSelection 中放置了一个 TCircle，将圆圈对齐设置为 alClient，每边填充为 5，并将例程修改为使用 Circle1 和 Circle2，而不是Selection1 和 Selection2。结果证明，如果圆圈本身没有重叠（或者更确切地说，它们的区域没有重叠），那么在边缘实际接触之前，它们不会被视为碰撞。显然，圆的角本身就是一个问题，但是您也许可以在每个圆内添加另一个子组件，并将其可见性设置为 false，并且它的尺寸略小，以模仿旧的“边界框”碰撞方法检测。

示例应用程序

我添加了一个示例应用程序，上面显示了源代码。第一个选项卡提供了一个可用的示例，而第二个选项卡简要说明了 TRectF 的工作原理（并通过使用类似雷达的可视界面显示了一些限制。第三个选项卡演示了使用 TBitmapListAnimation 创建动画图像。

FMX Collision Detection - Example and Source

【讨论】：

感谢您的回答，但我正在寻找的不是重叠的矩形，而是重叠的任意形状。测试 rect-hits 只是第一步。
我相信他所说的是一个例子，你必须拿一个区域（在这种情况下为矩形），看看它是否另一个区域（在这种情况下）共享相同的区域。因此，这适用于任何形状。
我相信无论实际显示的形状如何，所有形状都使用矩形“命中框”。我提到了偏移量作为设置负偏移量让你通过它的命中框来模仿形状。例如，我设法检查了通过矩形碰撞框碰撞的圆，并通过将碰撞框的角放在圆的边缘之外来模仿它。这不是绝对的精确度，但这确实意味着我遇到了对重叠形状过于敏感和不够敏感的中间立场。我将再次对此进行调查，看看是否可以提出更好的解决方案。

【解决方案3】：

在我看来，有太多可能的排列可以轻松地有效地解决这个问题。一些特殊情况可能有一个简单有效的解决方案：例如通过仅考虑光标上的单个点来简化鼠标光标交叉；提供了一种非常好的圆圈技术；许多规则形状也可能受益于自定义公式来检测碰撞。

但是，不规则的形状使问题变得更加困难。

一种选择是将每个形状包围在一个假想的圆圈中。如果这些圆圈重叠，那么您可以想象在原始交叉点附近有更小更紧密的圆圈。根据需要，用越来越小的圆圈重复计算。这种方法将允许您在处理要求和检测精度之间进行权衡。

一种更简单且非常通用的方法是使用纯色和 xor 蒙版将每个形状绘制到屏幕外的画布上，尽管效率稍低。绘制后，如果找到任何异或颜色的像素，则表明发生了冲突。

【讨论】：

【解决方案4】：

在此开始/设置TCircle、TRectangle 和 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.

【讨论】：

【解决方案5】：

猜我们必须自己动手。

对此的一种选择是Gilbert-Johnson-Keerthi distance algorithm 的二维实现。

A D 实现可以在这里找到：http://code.google.com/p/gjkd/source/browse/

【讨论】：