Как посмотреть, перекрываются ли две фигуры
Я пытаюсь написать простое тестовое приложение 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
создавать анимированные изображения.
Мне кажется, что существует слишком много возможных перестановок, чтобы легко и эффективно решить эту проблему. Некоторые особые случаи могут иметь простое и эффективное решение: например, пересечение курсора мыши упрощается, если учитывать только одну точку на курсоре; была предоставлена очень хорошая техника для кругов; Многие регулярные формы могут также извлечь выгоду из пользовательских формул для обнаружения столкновения.
Однако неправильные формы значительно усложняют проблему.
Один из вариантов - заключить каждую фигуру в воображаемый круг. Если эти круги перекрываются, вы можете представить меньшие более плотные круги в окрестности исходного пересечения. Повторите расчеты с меньшими и меньшими кругами так часто, как это необходимо. Этот подход позволит вам выбрать компромисс между требованиями к обработке и точностью обнаружения.
Более простой и очень общий - хотя и несколько менее эффективный подход - рисовать каждую фигуру за пределами экрана, используя сплошные цвета и маску 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/