Dan Dan - 10 months ago 158
Pascal Question

Delphi collision detection issues with more than one object

For some reason my collision code isn't working with more than one object. It works perfectly with one but when I try to do it with another object at the same time it fails and the player can move through each object. I plan to create the objects in a dynamic array and loop through this code for each object but it has the same issue as there is some problem with running the code twice that breaks all the collision detection?

Full project paste bin with 1 object working:
https://pastebin.com/MgEdbE4N
Full project paste bin with 2 objects not working:
https://pastebin.com/D3dpyxxD

On timer procedure with collision detection code for both objects copied twice:

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;

Dsm Dsm
Answer Source

Effectively your code says "If A collides does not collide with B OR A does not collide with C then move" What you need is the opposite "If A does not collide with B AND A does not collide with C then move", e.g.

// 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;

and similarly for your other tests.

Obviously we are merging the 2 blocks so there should only be one block when you are done.

Edit 1

Obviously this is not suitable for multiple shapes - it just shows you why what you are doing does not work. You need to refactor.

Look at this an example of what you need to do:

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;

This is both testing for collision if we move, then if our direction is down, we move. Well we are doing the complicated test first then the simple bit. Both must be true so the first stage is reverse the order

        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;

But this is still doing the collision test and move together, so we separate out

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;

OK, now we have separated collision detect and movement for d, multiple shapes becomes easy

Something like

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;

Now all of this is untested - I am just aiming to show you how to proceed - I am not going to write your code for you. Plus you need to repeat for s, w and a.

But hopefully you can see the value of structuring your code properly now.

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download