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

Answer 1

一般问题很难并称为碰撞检测 - 您可以谷歌搜索该术语以查找相关算法。

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

Answer 2

虽然这个问题已经超过一年了，但最近我遇到了类似的问题。感谢对TRectF（FMX和FM2基元使用）的一些研究，我提出了以下非常简单的功能;

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）并且可能找到一种方法来添加偏移量（看看TControl.GetAbsoluteRect中的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，并且尺寸略小，以模仿旧的“边界框”碰撞方法检测

示例应用

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

FMX Collision Detection - Example and Source

Answer 3

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

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

一种选择是将每个形状包围在一个假想的圆圈中。如果这些圆圈重叠，您可以想象在原始交叉点附近的较小的较紧的圆圈。根据需要，使用较小和较小的圆圈重复计算。这种方法允许您选择处理要求和检测准确性之间的权衡。

更简单且非常通用 - 虽然效率稍低的方法是使用纯色和xor蒙版将每个形状绘制到离屏画布上。绘图后，如果找到任何xor颜色的像素，则表示发生碰撞。

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

Answer 5

猜猜我们必须自己动手。

这方面的一个选项是Gilbert-Johnson-Keerthi distance algorithm的2D实现。

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

如何看两个形状是否重叠

5 个答案: