Было написано костыль, для быстрого решение... то так идея с отдельным потом, мне нравится. Так как нет других решений.
Прилегаю файл, как и просили.
procedure TBlocksFrame.SetInitializationLattice;
var
i, j: Integer;
xRectangle: TLatticeRectangle;
xHeight, xWidth: Single;
begin
xHeight := Self.Height/ROW_COUNT_SIZE;
xWidth := Self.Width/COL_COUNT_SIZE;
if (xHeight > 0) and (xWidth > 0) then
begin
for i := 0 to ROW_COUNT_SIZE - 1 do
for j := 0 to COL_COUNT_SIZE - 1 do
begin
xRectangle := TLatticeRectangle.Create(Self);
SetPostionRectangle(xRectangle,
j * xWidth + 1.25, i * xHeight + 1.25, xHeight - 2.5, xWidth - 2.5);
xRectangle.Row := i;
xRectangle.Col := j;
xRectangle.Parent := Self;
xRectangle.OnEnter := RectangleOnEnter;
xRectangle.OnMouseDown := RectangleOnMouseDown;
xRectangle.OnMouseMove := RectangleOnMouseMove;
xRectangle.OnMouseUp := RectangleOnMouseUp;
FLatticeles.Add(xRectangle);
end;
end;
end;
procedure TBlocksFrame.SetUpDatesLattice;
var
i, j, xIndex: Integer;
xLattice: TLatticeRectangle;
xHeight, xWidth: Single;
begin
xHeight := Self.Height/ROW_COUNT_SIZE;
xWidth := Self.Width/COL_COUNT_SIZE;
if (xHeight > 0) and (xWidth > 0) then
begin
for i := 0 to ROW_COUNT_SIZE - 1 do
for j := 0 to COL_COUNT_SIZE - 1 do
begin
xIndex := i * COL_COUNT_SIZE + j;
xLattice := FLatticeles[xIndex];
if Assigned(xLattice) then
begin
SetPostionRectangle(xLattice,
j * xWidth + 1.25, i * xHeight + 1.25, xHeight - 2.5, xWidth - 2.5);
end;
end;
end;
end;
// сейчас так
procedure TBlocksFrame.TimerTimer(Sender: TObject);
begin
if (FSelfHeight = 0) and (FSelfWidth = 0) then
begin
FSelfHeight := Self.Height;
FSelfWidth := Self.Width;
Self.SetInitializationLattice;
end
else
begin
if (FSelfHeight <> Self.Height) or (FSelfWidth <> Self.Width) then
begin
FSelfHeight := Self.Height;
FSelfWidth := Self.Width;
if FLatticeles.Count = 0 then
Self.SetInitializationLattice
else
begin
SetUpDatesLattice;
SetUpDatesBlock;
end;
end;
end;
end;
// было так
procedure TBlocksFrame.Resize;
begin
inherited Resize;
if (FSelfHeight = 0) and (FSelfWidth = 0) then
begin
FSelfHeight := Self.Height;
FSelfWidth := Self.Width;
Self.SetInitializationLattice;
end
else
begin
if (FSelfHeight <> Self.Height) or (FSelfWidth <> Self.Width) then
begin
FSelfHeight := Self.Height;
FSelfWidth := Self.Width;
if FLatticeles.Count = 0 then
Self.SetInitializationLattice
else
begin
SetUpDatesLattice;
SetUpDatesBlock;
end;
end;
end;
end;
block.zip