4

シンプルな firemonkey テスト アプリを作成しようとしています。

パネル (align:= alClient) のあるフォームがあります。
フォームには 2 がありTCircleます。TCircle.Dragmode:= dmAutomatic を設定しました。

円をドラッグして、円が重なったときに何かが起こるようにしたいと思います。
問題は、オーバーラップと呼ばれる TCircle のメソッドも、オーバーラップで呼び出されるイベントも見当たりません。すべての xxxxDrag イベントを試しましたが、ヒットテストには役立ちません。

ドラッグ中の形状が別の形状と重なっているのを確認するにはどうすればよいですか? イベントの 1 つがこれを検出する
ことを期待していましたが、そうではないようです。 DragOverDragEnter

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
4

5 に答える 5

16

一般的な問題は難しく、衝突検出として知られています。関連するアルゴリズムを見つけるために用語をグーグルで検索できます。

円の衝突検出の特定のケースは簡単です。円の中心間の距離を計算するだけです。得られた距離が円の半径の合計より小さい場合、円は重なります。

于 2011-10-02T20:37:29.253 に答える
1

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.
于 2013-09-20T21:59:38.920 に答える
1

この質問は 1 年以上前のものですが、最近同様の問題に直面していました。(FMX および FM2 プリミティブで使用される)について少し調査したおかげTRectFで、次の非常に単純な関数を思いつきました。

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 つの長方形/オブジェクトが交差または重なり合っている場合、結果は true になります。

代替 - 同じルーチンですが、コードが洗練されています

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

いくつかの入力オブジェクトを受け入れるように作業する必要があります (私の場合は、TSelectionSelection1 および Selection2 として知られている を使用しました)。おそらく、オフセットを追加する方法を見つけます (を参照してくださいTControl.GetAbsoluteRect) FMX.Types。ただし、理論的には機能するはずです。ほぼすべてのプリミティブまたはコントロールで。

追加の注意として、TRectFこのようなオブジェクトには多数の が使用されています。

  • AbsoluteRect
  • BoundsRect
  • LocalRect
  • UpdateRect(この状況には当てはまらない場合があります。調査が必要です)
  • ParentedRect
  • ClipRect
  • ChildrenRect

状況に最も適したものを使用することが重要です (結果はケースごとに大きく異なるため)。私の例では、TSelectionはフォームの子だったので、 を使用することAbsoluteRectが最良の選択でした (LocalRect正しい値を返さなかったので)。

現実的には、親の各子コンポーネントをループして、潜在的に衝突があるかどうかを判断できるようにすることができます。どのコンポーネントが衝突しているかを正確に伝える関数を構築できます (ただし、そのためには再帰関数が必要になる可能性があります)。 ）。

Firemonkey で衝突検出が 1 つ (少なくともこの場合は基本レベル) と見なされる「基本的な物理学」に対処する必要がある場合は、対処TRectFする必要があります。System.Typesこの問題を自動的に処理するために (XE3 およびおそらく XE2) に組み込まれた多くのルーチンがあり、この問題に一般的に関連する多くの計算を回避できます。

その他の注意事項

私が注意したことは、上記のルーチンはあまり正確ではなく、数ピクセルずれていたことです。解決策の 1 つは、親コンテナー内に図形をalClient配置して配置し、すべての側面に 5 ピクセルのパディングを行うことです。次に、 を測定する代わりにTSelection.AbsoluteRect、子オブジェクトの を測定しますAbsoluteRect。

たとえば、TCircle各 TSelection 内に を配置し、円の配置を に設定し、alClient両側のパディングを 5 に設定し、ルーチンをCircle1andCircle2ではなくSelection1andで動作するように変更しましたSelection2。これは、円自体が重ならない (または、その領域が重ならない) 場合、エッジが実際に接触するまで衝突していると見なされないという点で正確であることが判明しました。明らかに、円自体の角が問題ですが、各円の内側に別の子コンポーネントを追加して、可視性を false に設定し、サイズをわずかに小さくして、古い「バウンディング ボックス」衝突方法を模倣することができます。検出。

適用例

上記を示すソース付きのサンプル アプリケーションを追加しました。1 つのタブは使用可能な例を提供し、2 番目のタブは TRectF がどのように機能するかについての簡単な説明を提供します (そして、レーダーのようなビジュアル インターフェイスを使用していくつかの制限を示します) TBitmapListAnimation。

FMX 衝突検出 - 例とソース

于 2012-11-17T21:38:33.900 に答える
1

この問題を一般的かつ効率的に簡単に解決するには、可能な順列が多すぎるように思えます。いくつかの特殊なケースでは、単純で効率的な解決策がある場合があります。たとえば、マウス カーソルの交点は、カーソル上の 1 点のみを考慮することで単純化されます。円のための非常に優れたテクニックが提供されています。多くの規則的な形状は、衝突を検出するためのカスタム式からも恩恵を受ける可能性があります。

ただし、不規則な形状は問題をより困難にします。

1 つのオプションは、各図形を仮想円で囲むことです。これらの円が重なっている場合は、元の交差点の近くに、より小さなより狭い円が想像できます。必要に応じて、円をどんどん小さくして計算を繰り返します。このアプローチにより、処理要件と検出精度の間のトレードオフを選択できます。

よりシンプルで非常に汎用的な方法ですが、単色と xor マスクを使用してオフスクリーン キャンバスに各形状を描画する方法は、やや効率的ではありません。描画後、xor カラーのピクセルが見つかった場合、これは衝突を示します。

于 2013-09-18T06:49:31.483 に答える