Question

由于某些原因，我的碰撞代码不能与多个对象一起使用。它与一个完美配合，但是当我尝试用另一个对象同时失败并且玩家可以穿过每个对象时。我计划在动态数组中创建对象并为每个对象循环遍历此代码，但它有同样的问题，因为运行代码两次会导致所有碰撞检测出现问题？

包含1个对象的完整项目粘贴框： https://pastebin.com/MgEdbE4N 完整项目粘贴bin，其中2个对象不起作用： https://pastebin.com/D3dpyxxD

关于两次复制的对象的碰撞检测代码的定时器程序：

        procedure TForm1.OnTick(Sender: TObject);
      var IntersectionRect: TRect;
    begin
    //First object
      if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
        begin
          if d = true then
          Image1.Left := Image1.Left + 5;
        end;
      if not((Image1.BoundsRect.BottomRight.Y >= Shape1.Top - 10) and (Image1.BoundsRect.BottomRight.Y <= Shape1.Top + 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
       begin
         if s = true then
          Image1.Top := Image1.Top + 5;
       end;
      if not((Image1.BoundsRect.TopLeft.X - 10 <= (Shape1.Left + Shape1.Width)) and (Image1.BoundsRect.TopLeft.X + 10 >= (Shape1.Left + Shape1.Width))  and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
      begin
        if a = true then
        Image1.Left := Image1.Left - 5;
      end;
     if not((Image1.BoundsRect.TopLeft.Y <= Shape1.BoundsRect.BottomRight.y + 10) and (Image1.BoundsRect.TopLeft.Y >= Shape1.BoundsRect.BottomRight.y - 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
      begin
        if w = true then
        Image1.Top := Image1.Top - 5;
      end;


    //second object
       if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape2.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape2.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape2.BoundsRect)) then
        begin
          if d = true then
          Image1.Left := Image1.Left + 5;
        end;
      if not((Image1.BoundsRect.BottomRight.Y >= Shape2.Top - 10) and (Image1.BoundsRect.BottomRight.Y <= Shape2.Top + 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape2.BoundsRect)) then
       begin
         if s = true then
          Image1.Top := Image1.Top + 5;
       end;
      if not((Image1.BoundsRect.TopLeft.X - 10 <= (Shape2.Left + Shape2.Width)) and (Image1.BoundsRect.TopLeft.X + 10 >= (Shape2.Left + Shape1.Width))  and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape2.BoundsRect)) then
      begin
        if a = true then
        Image1.Left := Image1.Left - 5;
      end;
     if not((Image1.BoundsRect.TopLeft.Y <= Shape2.BoundsRect.BottomRight.y + 10) and (Image1.BoundsRect.TopLeft.Y >= Shape2.BoundsRect.BottomRight.y - 10) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape2.BoundsRect)) then
      begin
        if w = true then
        Image1.Top := Image1.Top - 5;
      end;
end;

Answer 1

有效地你的代码说＆＃34;如果A碰撞不碰撞B OR A不碰撞C然后移动＆＃34;你需要的是相反的＆＃34;如果A不与B碰撞 AND A不与C碰撞然后移动＆＃34;，例如

// both objects
      if (not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect))
      and (not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape2.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape2.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape2.BoundsRect)) ) then
        begin
          if d = true then
          Image1.Left := Image1.Left + 5;
        end;

和您的其他测试类似。

显然我们正在合并2个块，所以当你完成时应该只有一个块。

编辑1

显然这不适合多种形状 - 它只是告诉你为什么你做的不起作用。你需要重构。

请看这个你需要做的例子：

if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
        begin
          if d = true then
          Image1.Left := Image1.Left + 5;
        end;

如果我们移动，这是测试碰撞，然后如果我们的方向下降，我们移动。好吧，我们首先进行复杂的测试然后是简单的位。两者都必须为真，所以第一阶段是颠倒顺序

        if d = true then
          if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then
          begin
            Image1.Left := Image1.Left + 5;
          end;

但这仍然是碰撞测试并一起移动，所以我们分开了

function CollideD( Image1 : TImage Shape1Rect : TShape );  // or as appropriate
begin
              if not(((Image1.Width + Image1.BoundsRect.TopLeft.x) >= Shape1.Left-10 ) and ((Image1.Width + Image1.BoundsRect.TopLeft.x) <= Shape1.Left+10 ) and IntersectRect(IntersectionRect, Image1.BoundsRect, Shape1.BoundsRect)) then Result := FALSE else Result := TRUE; 

end;

procedure MoveD( Iamge1 : TImage );
begin
     Image1.Left := Image1.Left + 5;
end;

...

  if d = true then
   if not CollideD( Image1, Shape1 ) then 
   begin
     MoveD( Image1 );
   end;

好的，现在我们已经分离了碰撞检测和d的移动，多个形状变得容易

像

这样的东西

var
  iCanMove : Boolean;

...

   iCanMove := TRUE;
   if d then
   begin

     for I := 0 to ShapeList.Count - 1 do
     begin
       if CollideD( Image1, ShapeList[ I ] ) then
       begin
         iCanMove : FALSE;
         break; 
       end;
     end;
     if iCanMove then MoveD( Image1 );
   end;

现在所有这些都未经过测试 - 我的目的是向您展示如何继续 - 我不打算为您编写代码。另外，你需要重复s，w和a。

但希望您现在能够正确看到构建代码的价值。

Delphi碰撞检测问题涉及多个对象

1 个答案:

编辑1