如何使用Delphi防止形状在表单上传递另一个形状?

时间:2017-11-06 21:04:48

标签: delphi

我不知道这是否太模糊(这是我的第一次),但我试图想办法如何防止用户控制的形状通过表单本身的另一个形状。到目前为止,我已经让可移动的形状在它碰到另一个形状时显示一条消息,但是,我想改变它,这样用户的形状就不能通过另一个固定的形状,并且在它撞击时停止向它行进的方向移动物体。我将非常感谢您的帮助或可能的解决方案,谢谢。

到目前为止的代码在这里

procedure TfrmMazeDesign1.Timer1Timer(Sender: TObject);
begin

  case direction of
    1:
      ShpUser.Top := ShpUser.Top - 1;

    2:
      ShpUser.Top := ShpUser.Top + 1;

    3:
      ShpUser.Left := ShpUser.Left - 1;

    4:
      ShpUser.Left := ShpUser.Left + 1;

end;

  if ShpUser.Left + ShpUser.Width = Shape1.Left  then

     showmessage('hitbar');

  if ShpUser.Left = Shape1.Left + Shape1.Width  then

     showmessage('hitbar');

end;

2 个答案:

答案 0 :(得分:1)

在两个形状/矩形之间进行碰撞检测时,我建议您使用可用的方法IntersectRect,它可以让您轻松检查两个矩形是否相互交叉。

接下来你应该做的是,当你检测到两个矩形之间的碰撞时,你需要在碰撞前将移动的矩形移回到位置。
在您的示例中,您将矩形移动一个像素,这意味着如果检测到碰撞,您只需将形状向相反方向移动一个像素。这就是为什么你可以检查你的案例陈述中的碰撞,以获得有关你手上最后移动方向的信息 但是如果你打算用多个像素移动你的形状,你可能想要移动你的移动形状,以至于它只是触及另一个形状

以下是此解决方案的代码示例,其中包含一些注释以便更好地理解:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var IntersectionRect: TRect;
begin
  case Key of
    VK_Left:
    begin
      //Move shape into new position
      Shape1.Left := Shape1.Left - 1;
      //Check for intersection of the shape rectangle against other shape rectangle
      //First parameter which needs to be of variable type us used by function to return
      //the dimensions of overlaping area/rectangle of the two provided rectangles
      if IntersectRect(IntersectionRect, Shape1.BoundsRect, Shape2.BoundsRect) then
      begin
        showmessage('left side collision');
        //After detecting collision move shape back to previous possition
        //If you are moving your shapes by more than one pixel you might want to
        //reposition your so that it positioned just to the right of the other shape
        //Shape1.Left := Shape2.Left + Shape2.Width + 1;
        Shape1.Left := Shape1.Left + 1;
      end;
    end;
    VK_Right:
    begin
      Shape1.Left := Shape1.Left + 1;
      if IntersectRect(IntersectionRect, Shape1.BoundsRect, Shape2.BoundsRect) then
      begin
        showmessage('right side collision');
        Shape1.Left := Shape1.Left - 1;
      end;
    end;
    VK_Up:
    begin
      Shape1.Top := Shape1.Top - 1;
      if IntersectRect(IntersectionRect, Shape1.BoundsRect, Shape2.BoundsRect) then
      begin
        showmessage('tops side collision');
        Shape1.Top := Shape1.Top + 1;
      end;
    end;
    VK_Down:
    begin
      Shape1.Top := Shape1.Top + 1;
      if IntersectRect(IntersectionRect, Shape1.BoundsRect, Shape2.BoundsRect) then
      begin
        showmessage('bottom side collision');
        Shape1.Top := Shape1.Top - 1;
      end;
    end;
  end;
end;

答案 1 :(得分:0)

更新管理以使用网格工作

<complexType name="ProvApiException">
<sequence>
 <element name="errorCode" nillable="true" type="xsd:string"/>
 <element name="message" nillable="true" type="xsd:string"/>
 <element name="rootCause" nillable="true" type="xsd:string"/>
</sequence>