Как посмотреть, перекрываются ли две фигуры

Я пытаюсь написать простое тестовое приложение Firemonkey.

У меня есть форма, с панелью (выровнять:= alClient).
На бланке 2 TCircle"S. Я установил 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

5 ответов

Общая проблема сложна и известна как обнаружение столкновений - вы можете использовать термин Google, чтобы найти соответствующие алгоритмы.

Частный случай обнаружения столкновения кругов прост - просто рассчитайте расстояние между центрами кругов. Если полученное расстояние меньше суммы радиусов круга, круги перекрываются.

Хотя этому вопросу уже более года, недавно я столкнулся с подобной проблемой. Благодаря небольшому исследованию 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,

Например, я положил TCircle внутри каждого TSelection установите выравнивание окружностей в alClient, добавив к 5 на каждой стороне, и изменил процедуру для работы с Circle1 а также Circle2 в отличие от Selection1 а также Selection2, Это оказалось точным до такой степени, что если бы сами круги не перекрывались (точнее, их области не перекрывались), то они не будут рассматриваться как сталкивающиеся до тех пор, пока края фактически не коснутся. Очевидно, что углы самих кругов представляют собой проблему, но, возможно, вы могли бы добавить еще один дочерний компонент внутри каждого круга с его видимостью, установленной в false, и с немного меньшими размерами, чтобы имитировать старый метод столкновения "Ограничивающий прямоугольник". обнаружение.

Пример приложения

Я добавил пример приложения с источником, показывающим выше. На вкладке 1 приведен полезный пример, а на второй вкладке приведено краткое объяснение того, как работает TRectF (и показаны некоторые ограничения, связанные с использованием визуального интерфейса, похожего на радар. Есть третья вкладка, демонстрирующая использование TBitmapListAnimation создавать анимированные изображения.

Обнаружение столкновения FMX - пример и источник

Мне кажется, что существует слишком много возможных перестановок, чтобы легко и эффективно решить эту проблему. Некоторые особые случаи могут иметь простое и эффективное решение: например, пересечение курсора мыши упрощается, если учитывать только одну точку на курсоре; была предоставлена ​​очень хорошая техника для кругов; Многие регулярные формы могут также извлечь выгоду из пользовательских формул для обнаружения столкновения.

Однако неправильные формы значительно усложняют проблему.

Один из вариантов - заключить каждую фигуру в воображаемый круг. Если эти круги перекрываются, вы можете представить меньшие более плотные круги в окрестности исходного пересечения. Повторите расчеты с меньшими и меньшими кругами так часто, как это необходимо. Этот подход позволит вам выбрать компромисс между требованиями к обработке и точностью обнаружения.

Более простой и очень общий - хотя и несколько менее эффективный подход - рисовать каждую фигуру за пределами экрана, используя сплошные цвета и маску xor. После рисования, если найдены какие-либо пиксели цвета xor, это будет означать столкновение.

Настоящим начало / настройка для обнаружения столкновений между 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.

Думаю, мы должны свернуть свои собственные.

Одним из вариантов для этого является двухмерная реализация алгоритма расстояния Гилберта-Джонсона-Керти.

Реализацию A D можно найти здесь: http://code.google.com/p/gjkd/source/browse/

Другие вопросы по тегам