Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 152
  • Last Modified:

Multiple image collision

Hi all,
 Back to ask another Delphi question.
Suppose i have four or more moving images on a form (panel or whatever) that are moving from the bottom of the form to the top, once they go off screen (cannot be seen anymore) they have their Top positions reset to a random value that is between the areas of the bottom most part of the form and some large number (that way the images appear at differing time intervals upon the visible part of the form), at the same time as their top positions are reset, they also have their Left property set a random value...
Now the trouble is, sometimes these images will overlap and one will be on top of the other!, i need some method of detecting this and then correcting it by assigning a new Top and Left property to the image/s

How is collision detection done with multiple images?.
two images are fine you just check
 "if (image1.top <= image2.top +image2.height) and (image1.top >= image2.top) then"
and if these conditions are met you can simply execute
 "image2.top := image1.top +(image1.height +10)"
but things get more complicated with multiple images, as you need to check the condition of each individual image and then when you change the Top and Left properties of one image you must recheck the values of all other images AGAIN to make sure that the new Top and Left values of the image you just moved do not collide with yet another image!.
0
Jai Sewell
Asked:
Jai Sewell
  • 6
  • 4
  • 2
  • +1
1 Solution
 
EddieShipmanCommented:
It is better to tell if the images overlap than attempting to keep track of where they are.
See how it is done with balls in the java screen saver code in the selected answer here:
http://stackoverflow.com/questions/19588605/simple-bouncing-ball-program-in-java
1
 
Geert GruwezOracle dbaCommented:
You know all the top and left of the objects.
Look in the controls property of the form

No need for collission detection.

You could use Ptinrect to check a point
1
 
Jai SewellAuthor Commented:
So does that mean that...

if (Math.abs(x_pos2-x_pos1)<radius1+radius2){
    ballspeedx1 = -ballspeedx1;
    ballspeedx2 = -ballspeedx2;
  }

becomes something like...

if ((Image2.Top-Image1.Top) < (Image1.Top +Image1.Height) +(Image2.Top +Image2.Height)) then
 begin
  Image2.Top := Image1.Top +Image1.Height +10;
 end;

And if so, i must also then account for when Image3 overlaps Image4, Image2 and Image1...
Image4 must also be checked against Image1, Image2 and Image3...
Then Image1 must be checked against Image3 and Image4
While Image2 is also checked against Image3 and Image4
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Jai SewellAuthor Commented:
I had a bit of an idea and i punched together the following code...
Please let me know what you guys think :)

procedure CheckOverlap;
var X, Y: integer;
ChkImage, RefImage: TImage;
begin
for X := 1 to 4 do
 begin
  ChkImage := FindComponent('Image' +IntToStr(X)) as TImage;
  for Y := 1 to 4 do
   begin
    if Y <> X then
     begin
      RefImage := FindComponent('Image' +IntToStr(Y)) as TImage;
      if (ChkImage.Top >= RefImage.Top) and ( (ChkImage.Top) <= (RefImage.Top +RefImage.Height) ) then
       begin
        ChkImage.Top := (RefImage.Top +RefImage.Height) +10;
       end
     end
   end
 end

Open in new window

0
 
Geert GruwezOracle dbaCommented:
always +10 ?
that means you're always moving the item down ?
1
 
Jai SewellAuthor Commented:
Yes it does mean that the image is always moved down if it overlaps any other image (it wont move otherwise), that is because all the images are lined up off screen (outside of the visible area on the form, so that when they do appear on the form they are all lined up perfectly, oooh i should note that the images slowly scroll up from the bottom of the form to the top) and that is for the code above, i have since modified the code too allow for moving to the right with the Left property.

procedure TMain.CheckOverlap;
var X, Y: integer;
ChkImage, RefImage: TImage;
begin
for X := 1 to 4 do
 begin
  ChkImage := FindComponent('island' +IntToStr(X)) as TImage;
  for Y := 1 to 4 do
   begin
    if Y <> X then
     begin
      RefImage := FindComponent('island' +IntToStr(Y)) as TImage;
      if (ChkImage.Top >= RefImage.Top) and ( (ChkImage.Top) <= (RefImage.Top +RefImage.Height) ) then
       begin
        if RefImage.Left +RefImage.Width <= 307 then ChkImage.Left := (RefImage.Left +RefImage.Width) +10
        else ChkImage.Top := (RefImage.Top +RefImage.Height) +10;
       end
     end
   end
 end
end;

Open in new window

0
 
Geert GruwezOracle dbaCommented:
why is the overlap a problem ?
0
 
Jai SewellAuthor Commented:
Because it does not look right, (the images have transparent properties and you can see one image "ghosting" in through the other and it becomes extremely pixelated.
I will try to attach a screen dump of this using the Attach File link, i have never used it before, so lets see how it goes :)
Overlap of two images
0
 
Sinisa VukCommented:
May I suggest a matrix of TPoint type. Take one random object (image) with property of Width and Height into one TPoint and set to first position in a matrix. Then get second random object from a list and so on... When you take all objects - calculate position for each of them...
Matrix:
O1  O2  O3
O4  O5  O6
X position of Object1 is random value from 0 ... (<width of screen> - <sum of Width of all remain objects in a row inc. Object1>)
X position of Object2 is random value from (<pos. of obj1>+<width of obj1>) ...  (<width of screen> - <sum of Width of all remain objects in a row  inc. Object2>)
...

Y position calculate same/similar way...
----
Why I subtract <width of screen> and <sum of Width of all remain objects in a row  inc. ObjectX>?
Because I need to be sure that I will have enough room for all next objects. You can add more space around object if want.
0
 
Jai SewellAuthor Commented:
Got any code to go with that Sinisa?
0
 
Geert GruwezOracle dbaCommented:
have you seen the movie Avatar ?
Change the islands to floating islands like those from Avatar

It would look better and then they can float above one another.

you'll have to calculate in 3 dimensions then ...
0
 
Jai SewellAuthor Commented:
Yeah nope, i am not planning to make money from this and if i wanted something more graphical i would use unity and 3D studio max
0
 
Sinisa VukCommented:
Hi.
Made not (so) simple example with some modifications on top of my first idea.

type
  TMoveObject = record
    Size: TSize;
    Gap: TPoint;
    Pos: TPoint;
    ObjPtr: Pointer;
  end;

  TMoveObjectArray = array of TMoveObject;
  PMoveObjectArray = ^TMoveObjectArray;

  TMatrix3x3 = array[0..2] of array[0..2] of TMoveObject;

function MakeTSize(w, h: Integer): TSize;
begin
  Result.cx := w;
  Result.cy := h;
end;

procedure ShuffleArray(ObjArr: PMoveObjectArray);
  procedure SwapObjects(n, m: integer);
  var
    tmp: TMoveObject;
  begin
    tmp := ObjArr^[n];
    ObjArr^[n] := ObjArr^[m];
    ObjArr^[m] := tmp;
  end;
var
  i: Integer;
begin
  for i := High(ObjArr^) downto 1 do
    SwapObjects(i, Random(Length(ObjArr^)));
end;

function GetLeftTopPos(x, y: Integer; m: TMatrix3x3): TPoint;
var
  i, j, s: Integer;
begin
  //get sum of all widths/heights before selected object
  Result := Point(0, 0);
  //top
  for j := Low(m) to y-1 do //y
  begin
    s := 0;
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      s := Max(s, m[j, i].Size.cy + m[j, i].Gap.Y);
    end;
    Result.Y := Result.Y + s;
  end;

  //left
  for i := Low(m[y]) to x-1 do //x
  begin
    s := 0;
    for j := Low(m) to High(m) do //y
    begin
      s := Max(s, m[j, i].Size.cx + m[j, i].Gap.X);
    end;
    Result.X := Result.X + s;
  end;
end;

procedure CalcNewPos(ParentW, ParentH: Integer; var m: TMatrix3x3);
var
  i, j, s: Integer;
  StartPos: TPoint;
  sz: TSize;
  GapSz, w, h: Integer;
begin
  sz :=MakeTSize(0, 0);
  w := 0;
  //get bounding rect - to calc max auto gap value
  for j := Low(m) to High(m) do //y
  begin
    s := 0;
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      s := s + m[j, i].Size.cx;
    end;
    w := max(w, s);
  end;

  h := 0;
  for i := Low(m[0]) to High(m[0]) do //x
  begin
    s := 0;
    for j := Low(m) to High(m) do //y
    begin
      s := s + m[j, i].Size.cy;
    end;
    h := max(h, s);
  end;
  //calc gap from remaing space
  GapSz := Min((ParentW - w) div (High(m[0]) - Low(m[0]) + 1), (ParentH - h) div (High(m) - Low(m) + 1));

  //randomize gaps
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      m[j, i].Gap := Point(Random(GapSz), Random(GapSz));
    end;
  end;

  //calc min positions inc. gaps
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      StartPos := GetLeftTopPos(i, j, m);
      //and add add gap
      m[j, i].Pos := Point(StartPos.X + m[j, i].Gap.X, StartPos.Y + m[j, i].Gap.Y);
    end;
  end;

  sz :=MakeTSize(0, 0);
  //get bounding rect
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      sz := MakeTSize(Max(sz.cx, m[j, i].Pos.X + m[j, i].Size.cx),
        Max(sz.cy, m[j, i].Pos.Y + m[j, i].Size.cy));
    end;
  end;

  //add bottom gap
  sz := MakeTSize(sz.cx + 0, sz.cy + 0);

  //now we have min-sized rectangle - we need to scale it to parent size....
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      m[j, i].Pos := Point(MulDiv(m[j, i].Pos.X, ParentW, sz.cx), MulDiv(m[j, i].Pos.Y, ParentH, sz.cy));
    end;
  end;
end;

procedure TForm1.Button15Click(Sender: TObject);
var
  m: TMatrix3x3;
  MObjs: TMoveObjectArray;
  i, j, n: Integer;
begin
  //init
  Randomize;
  ZeroMemory(@m, SizeOf(TMatrix3x3));
  SetLength(MObjs, 9);

  //fill object array
  MObjs[0].Size := MakeTSize(Shape1.Width, Shape1.Height);
  MObjs[1].Size := MakeTSize(Shape2.Width, Shape2.Height);
  MObjs[2].Size := MakeTSize(Shape3.Width, Shape3.Height);
  MObjs[3].Size := MakeTSize(Shape4.Width, Shape4.Height);
  MObjs[4].Size := MakeTSize(Shape5.Width, Shape5.Height);
  MObjs[5].Size := MakeTSize(Shape6.Width, Shape6.Height);
  MObjs[6].Size := MakeTSize(Shape7.Width, Shape7.Height);
  MObjs[7].Size := MakeTSize(Shape8.Width, Shape8.Height);
  MObjs[8].Size := MakeTSize(Shape9.Width, Shape9.Height);

  MObjs[0].ObjPtr := Shape1;
  MObjs[1].ObjPtr := Shape2;
  MObjs[2].ObjPtr := Shape3;
  MObjs[3].ObjPtr := Shape4;
  MObjs[4].ObjPtr := Shape5;
  MObjs[5].ObjPtr := Shape6;
  MObjs[6].ObjPtr := Shape7;
  MObjs[7].ObjPtr := Shape8;
  MObjs[8].ObjPtr := Shape9;

  for i := Low(MObjs) to High(MObjs) do
  begin
    MObjs[i].Pos := Point(0, 0);
    MObjs[i].Gap := Point(0, 0);
    TShape(MObjs[i].ObjPtr).Visible := False;
  end;

  //shuffle array ....
  ShuffleArray(@MObjs);

  //fill matrix
  n := Low(MObjs);
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      if n > High(MObjs) then Break;
      m[j, i] := MObjs[n];  //take next object from an array...
      Inc(n);
    end;
  end;

  //set new position
  CalcNewPos(Panel1.Width, Panel1.Height, m);

  //show
  for j := Low(m) to High(m) do //y
  begin
    for i := Low(m[j]) to High(m[j]) do //x
    begin
      TShape(m[j, i].ObjPtr).SetBounds(m[j, i].Pos.X, m[j, i].Pos.Y, m[j, i].Size.cx, m[j, i].Size.cy);
      TShape(m[j, i].ObjPtr).Visible := True;
    end;
  end;
end;

Open in new window


On panel I put 9 Tshape objects. On button click start:
-fill my array
-randomize array - with shuffle
-fill matrix  (3x3 - but can be any size)
-calculate additional gaps - to make more "exploded" ... - using random values
-calculate position
-get bounding rectangle of objects
-scale positions to fit parent (panel)
-show shapes on new position

Visually look like this:
Shapes on panel
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 4
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now