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
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;
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;
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Delphi Firemonkey Need Sample for Online Shopping Example. | 2 | 145 | |
IdTCPClient and IdTCPServer exchanging data on desktops and not Android | 11 | 115 | |
Edit a photo to make someone look drunker than they are (and funny) | 3 | 48 | |
Multi-layered image in FireMonkey | 9 | 38 |
Join the community of 500,000 technology professionals and ask your questions.