如何测试形状和面板是否在同一位置答案

【问题标题】：How to test if a shape and a panel are at the same location如何测试形状和面板是否在同一位置
【发布时间】：2012-10-15 07:22:34
【问题描述】：

这个想法是你必须拍摄面板。因此面板将被设置到屏幕顶部的随机位置，然后向下移动到屏幕底部。您必须在面板到达底部之前用形状拍摄面板。但我不知道如何测试创建的形状是否在面板的位置以重置面板。目前这是我的代码，但 if 测试为假。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg;

const
  MaxRays=100;
  RayStep=8;
type
   TForm1 = class(TForm)
   Panel1: TPanel;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Shape1: TShape;
    Timer3: TTimer;
    Image1: TImage;
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
       MousePos: TPoint; var Handled: Boolean);
     procedure Timer3Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    Rays:array[0..MaxRays-1] of TShape;

   public
   procedure StartPanelAnimation1;
   procedure DoPanelAnimationStep1;
   function  PanelAnimationComplete1: Boolean;
   { Public declarations }
  end;

var
  Form1: TForm1;

implementation
 var key : char;
{$R *.dfm}

{ TForm1 }



 { TForm1 }

 procedure TForm1.DoPanelAnimationStep1;
begin
Panel1.Top := Panel1.Top+1;
end;

function TForm1.PanelAnimationComplete1: Boolean;
begin
 Result := Panel1.Top=512;
end;

procedure TForm1.StartPanelAnimation1;
begin
  Panel1.Top := 0;
  Timer1.Interval := 1;
  Timer1.Enabled := True;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
   DoPanelAnimationStep1;
   if PanelAnimationComplete1 then
    StartPanelAnimation1;
   if (shape1.Top < panel1.Top) and (shape1.Left < panel1.Left+104) and (shape1.Left >       panel1.Left)   then
   begin
    startpanelanimation1;
    sleep(10);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 button1.Hide;
  key := 'a';
  timer2.Enabled := true;
  StartPanelAnimation1; 
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
 shape1.Visible := false;
 timer2.Enabled := false;
 end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
   begin
image1.Left := image1.Left-10;
end;

 procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
    begin
    image1.Left := image1.Left+10;
   end;

procedure TForm1.Timer3Timer(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to MaxRays-1 do
    if Rays[i]<>nil then
    begin
      Rays[i].Top:=Rays[i].Top-RayStep;
      if Rays[i].Top<0 then FreeAndNil(Rays[i]);
    end;
end;


procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
   var
   i:integer;
begin
  i:=0;
  while (i<MaxRays) and (Rays[i]<>nil) do inc(i);
  if i<MaxRays then
   begin
    Rays[i]:=TShape.Create(Self);
    Rays[i].Shape:=stEllipse;
    Rays[i].Pen.Color:=clRed;
    Rays[i].Pen.Style:=psSolid;
    Rays[i].Brush.Color:=clYellow;
    Rays[i].Brush.Style:=bsSolid;
    Rays[i].SetBounds(X-4,Y-20,9,41);
    Rays[i].Parent:=Self;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to MaxRays-1 do Rays[i]:=nil;
end;

end.

我已经尝试过@NGLN 所说的，但是当我单击鼠标按钮时，形状移动了 10 个像素然后停止，当它停止时，正常向下移动的面板现在在屏幕顶部疯狂移动改变它的左侧位置，但顶部位置保持 0。

这是新代码

unit Unit1;

interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, jpeg;

  const
  MaxRays=100;
  RayStep=8;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    Timer2: TTimer;
    Button1: TButton;
    Shape1: TShape;
    Timer3: TTimer;
    Image1: TImage;
    Timer4: TTimer;
    procedure Timer2Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure Timer3Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    Rays:array[0..MaxRays-1] of TShape;
  public
   procedure StartPanelAnimation1;
   procedure DoPanelAnimationStep1;
   function  PanelAnimationComplete1: Boolean;
   function EllipticShapeIntersectsPanel(Shape: TShape; Panel: TPanel): Boolean;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
 var key : char;
{$R *.dfm}

{ TForm1 }



{ TForm1 }

procedure TForm1.DoPanelAnimationStep1;
begin
Panel1.Top := Panel1.Top+1;
end;

function TForm1.PanelAnimationComplete1: Boolean;
begin
 Result := Panel1.Top=512;
end;

procedure TForm1.StartPanelAnimation1;
var left : integer;
begin
  Panel1.Top := 0;
  randomize;
  left := random(clientwidth-105);
  panel1.Left := left;
  Timer1.Interval := 1;
   Timer1.Enabled := True;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
 var I: Integer;
begin
 DoPanelAnimationStep1;
  if PanelAnimationComplete1 then
    StartPanelAnimation1;
   I := 0;
  while (Rays[I] <> nil) and (I < MaxRays)  do
  begin
    if EllipticShapeIntersectsPanel(Rays[I], Panel1) then
    Inc(I);
    startpanelanimation1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 button1.Hide;
 key := 'a';
 timer2.Enabled := true;
 StartPanelAnimation1;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
 shape1.Visible := false;
 timer2.Enabled := false;
end;

procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
image1.Left := image1.Left-10;
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
 image1.Left := image1.Left+10;
end;


procedure TForm1.Timer3Timer(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to MaxRays-1 do
    if Rays[i]<>nil then
    begin
      Rays[i].Top:=Rays[i].Top-RayStep;
      if Rays[i].Top<0 then FreeAndNil(Rays[i]);
    end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
 var
  i:integer;
  left : integer;
  top : integer;
begin
  i:=0;
  while (i<MaxRays) and (Rays[i]<>nil) do i:= i+10;
  if i<MaxRays then
   begin
    Rays[i]:=TShape.Create(Self);
    Rays[i].Shape:=strectangle;;
    Rays[i].Pen.Color:=clRed;
    Rays[i].Pen.Style:=psSolid;
    Rays[i].Brush.Color:=clred;
    Rays[i].Brush.Style:=bsSolid;
    left := image1.Left+38;
    top := image1.Top-30;
    Rays[i].SetBounds(left,top,9,33);
    Rays[i].Parent:=Self;
   end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Screen.Cursor:=crNone;
end;

function TForm1.EllipticShapeIntersectsPanel(Shape: TShape;
  Panel: TPanel): Boolean;
var
  ShapeRgn: HRGN;
begin
  with Shape.BoundsRect do
    ShapeRgn := CreateEllipticRgn(Left, Top, Right, Bottom);
  try
    Result := RectInRegion(ShapeRgn, Panel.BoundsRect);
  finally
    DeleteObject(ShapeRgn);
  end;
end;

end.

【问题讨论】：

标签： delphi delphi-7 collision-detection

【解决方案1】：

  if IntersectRect(Panel1.BoundsRect, Shape1.Boundsrect) then
  // collided

【讨论】：

形状是椭圆的，但对于 OP 来说可能已经足够了。
所以，也许你需要用数学来解决这个问题。没有办法做到简单。如果这个椭圆仅用一个维度拉伸，您可以尝试使用一些确定圆拉伸的系数来检查碰撞矩形与圆。
圆和椭圆的数学运算并不难，但this answer 对我来说似乎很容易。
您也可以通过逐像素检查轻松完成。首先，您必须检查 IntersectRect 的 Rect 和边界的椭圆。然后，如果有交叉点，则检查该交叉点中的每个像素。例如，如果您的椭圆是红色的，则必须检查像素是否为红色。最后，如果这个矩形中甚至没有一个红色像素 - 那么就没有真正的交叉点。此方法适用于任何形状。但是正如你所看到的，颜色是有限制的，它不能是渐变的。在这种情况下，您必须使用简单的彩色形状绘制类似于场景的缓冲区，然后按照我上面所说的检查交叉点。
是的，this answer 非常简单实用。

【解决方案2】：

传统的方法是检查对象1的所有4个角是否在对象2内。

function IsPanelCollide(Panel: TPanel; Shape: TShape): boolean;
var
  TL, TR, BL, BR: boolean;
begin
  // if TOP LEFT panel inside shape
  TL := (Panel.Top >= Shape.Top) AND (Panel.Top <= Shape.Top + Shape.Height) AND
        (Panel.Left >= Shape.Left) AND (Panel.Left <= Shape.Left + Shape.Width);

  // if TOP RIGHT panel inside shape
  TR := (Panel.Top >= Shape.Top) AND (Panel.Top <= Shape.Top + Shape.Height) AND
        (Panel.Left + Panel.Width >= Shape.Left) AND (Panel.Left + Panel.Width <= Shape.Left + Shape.Width);

  // if BOTTOM LEFT panel inside shape
  BL := (Panel.Top + Panel.Height >= Shape.Top) AND (Panel.Top + Panel.Height <= Shape.Top + Shape.Height) AND
        (Panel.Left >= Shape.Left) AND (Panel.Left <= Shape.Left + Shape.Width);

  // if BOTTOM RIGHT panel inside shape
  BR := (Panel.Top + Panel.Height >= Shape.Top) AND (Panel.Top + Panel.Height <= Shape.Top + Shape.Height) AND
        (Panel.Left + Panel.Width >= Shape.Left) AND (Panel.Left + Panel.Width <= Shape.Left + Shape.Width);

  Result := (TL) AND (TR) AND (BL) AND (BR);
end;

或者，您也可以使用一些库，例如 DelphiX 或任何专注于游戏制作的类似库。 DelphiX 有一个检查碰撞的方法，你不必使用自己的计时器，DelphiX 的计时器对于动画来说更好更流畅。

【讨论】：

DelphiX 是一个非常非常非常古老的库，你现在不应该使用它，因为它基于现在已经过时的 DirectDraw。

【解决方案3】：

由于您的形状是椭圆形，因此创建一个临时区域并确定与带有RectInRegion 的矩形的交点：

function EllipticShapeIntersectsPanel(Shape: TShape; Panel: TPanel): Boolean;
var
  ShapeRgn: HRGN;
begin
  with Shape.BoundsRect do
    ShapeRgn := CreateEllipticRgn(Left, Top, Right, Bottom);
  try
    Result := RectInRegion(ShapeRgn, Panel.BoundsRect);
  finally
    DeleteObject(ShapeRgn);
  end;
end;

（如果形状是rectangular，则可以使用Darthman的例程。）

现在将阵列中的每条光线输入到这个例程中：

procedure TForm1.Timer2Timer(Sender: TObject);
var
  I: Integer;
begin
  ...
  I := 0;
  while (Rays[I] <> nil) and (I < MaxRays)  do
  begin
    if EllipticShapeIntersectsPanel(Rays[I], Panel1) then
      // Do what you want to do
    Inc(I);
  end;
end;

【讨论】：

聪明的思考。或者，您可以对面板和圆的边界矩形进行初步检查，然后使用毕达哥拉斯定理进行更精细的检查。但是，如果您使用形状来构建游戏，则需要更多编程，并且首先要优化其他内容。 ;)
@Craig 如果在下一个计时器间隔中，一个或多个形状与面板发生碰撞，则此代码会再次运行，并再次...在您的代码中，您使用Sleep(10)。我希望这就是原因。在这个例程中做一些事情以防止它再次发生。例如：清除阵列中的射线。
@NGLN 我已经尝试过你所说的，但是当我单击鼠标按钮时，形状移动了 10 个像素然后停止，当它停止时，正常向下移动的面板现在正在疯狂移动屏幕顶部不断改变其左侧位置，但顶部位置保持 0。知道为什么会发生这种情况以及如何解决它吗？
@Craig 看，你问的是如何计算两个控件是否碰撞，而不是如何编写一个完整的游戏。对这个问题给出了答案，对我来说似乎已经足够了。抱歉，我们可以也可能不会解决您在 cmets 中的其他问题。请单独发布。