delphi - 如何查看两个形状是否重叠

Question

我正在尝试编写一个简单的 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

score 16 · Accepted Answer

一般的问题是困难的，被称为碰撞检测——你可以谷歌这个词来找到相关的算法。

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

score 1 · Accepted Answer

特此开始/设置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.

score 1 · Accepted Answer

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

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

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

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

score 1 · Accepted Answer

虽然这个问题已经有一年多了，但我最近也遇到了类似的问题。感谢对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 的 's ），并且可能会找到一种添加偏移量的方法（查看TControl.GetAbsoluteRect）FMX.Types，但理论上它应该可以工作几乎可以使用任何原语或任何控件。

作为附加说明，有许多TRectF's 用于此类对象；

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

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

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

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

进一步说明

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

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

示例应用程序

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

FMX 碰撞检测 - 示例和来源

score 0 · Accepted Answer

猜猜我们必须自己动手。

一种选择是Gilbert-Johnson-Keerthi 距离算法的 2D 实现。

广告实施可以在这里找到：http ://code.google.com/p/gjkd/source/browse/

delphi - 如何查看两个形状是否重叠

5 回答 5

Related

Reference