procedure AddToComponentsGeometry(Form: TForm; WinControl: TWinControl);
var
c, j, cd: integer;
EWinControl: TWinControl;
begin
c := Length(ComponentsGeometry);
SetLength(ComponentsGeometry, c + 1);
ComponentsGeometry[c].WinControl := WinControl;
ComponentsGeometry[c].TopWinControl := nil;
ComponentsGeometry[c].LeftWinControl := nil;
ComponentsGeometry[c].TopDistance := $7fffffff;
ComponentsGeometry[c].LeftDistance := $7fffffff;
ComponentsGeometry[c].Top := WinControl.Top;
ComponentsGeometry[c].Left := WinControl.Left;
ComponentsGeometry[c].Width := WinControl.Width;
ComponentsGeometry[c].Height := WinControl.Height;
for j := 0 to Form.ComponentCount - 1 do
begin
if (Form.Components[j] is TWinControl) then
begin
EWinControl := Form.Components[j] as TWinControl;
cd := WinControl.Top - (EWinControl.Top + EWinControl.Height);
if ((cd >= 0) and (cd < ComponentsGeometry[c].TopDistance)) then
begin
ComponentsGeometry[c].TopWinControl := EWinControl;
ComponentsGeometry[c].TopDistance := cd;
end;
cd := WinControl.Left - (EWinControl.Left + EWinControl.Width);
if ((cd >= 0) and (cd < ComponentsGeometry[c].LeftDistance)) then
begin
ComponentsGeometry[c].LeftWinControl := EWinControl;
ComponentsGeometry[c].LeftDistance := cd;
end;
end;
end;
end;
procedure StoreComponentsGeometry;
var i, j: integer;
begin
SetLength(ComponentsGeometry, 0);
for i := 0 to Screen.FormCount - 1 do
begin
for j := 0 to Screen.Forms[i].ComponentCount - 1 do
begin
if (Screen.Forms[i].Components[j] is TWinControl) then
begin
AddToComponentsGeometry(Screen.Forms[i], Screen.Forms[i].Components[j] as TWinControl);
end;
end;
end;
end;
procedure AlignItems;
var
i, j, c, d, Right, Bottom: integer;
WinControl: TWinControl;
begin
for i := 0 to Screen.FormCount - 1 do
begin
d := Screen.Forms[i].Font.Size - 10;
for j := 0 to Screen.Forms[i].ComponentCount - 1 do
begin
if (Screen.Forms[i].Components[j] is TWinControl) then
begin
WinControl := Screen.Forms[i].Components[j] as TWinControl;
c := 0; // silences warning
for c := 0 to length(ComponentsGeometry) - 1 do
begin
if (WinControl = ComponentsGeometry[c].WinControl) then
begin
break;
end;
end;
if (c < length(ComponentsGeometry)) then
begin
if (not WinControl.AutoSize) then
begin
WinControl.Width := ComponentsGeometry[c].Width + d;
WinControl.Height := ComponentsGeometry[c].Height + d;
end;
if (ComponentsGeometry[c].TopWinControl <> nil) then
begin
WinControl.Top := ComponentsGeometry[c].TopWinControl.Top + ComponentsGeometry[c].TopWinControl.Height + ComponentsGeometry[c].TopDistance;
end;
if (ComponentsGeometry[c].LeftWinControl <> nil) then
begin
WinControl.Left := ComponentsGeometry[c].LeftWinControl.Left + ComponentsGeometry[c].LeftWinControl.Width + ComponentsGeometry[c].LeftDistance;
end;
end;
end;
end;
end;
for i := 0 to Screen.FormCount - 1 do
begin
Right := 0;
Bottom := 0;
for j := 0 to Screen.Forms[i].ComponentCount - 1 do
begin
if (Screen.Forms[i].Components[j] is TWinControl) then
begin
WinControl := Screen.Forms[i].Components[j] as TWinControl;
c :=WinControl.Top + WinControl.Height;
if (c > Bottom) then
begin
Bottom := c;
end;
c :=WinControl.Left + WinControl.Width;
if (c > Right) then
begin
Right := c;
end;
end;
end;
Screen.Forms[i].Width := Right;
Screen.Forms[i].Height := Bottom;
end;
end;
procedure ApplyFontSize;
var i: integer;
begin
if (FontSize < 1) then
begin
FontSize := 1;
end
else
begin
if (FontSize > 24) then
begin
FontSize := 24;
end;
end;
for i := 0 to Screen.FormCount - 1 do
begin
Screen.Forms[i].Font.Size := FontSize;
end;
AlignItems;
end;
procedure StepFontSize(step: LongInt);
begin
FontSize := LongWord(LongInt(FontSize) + step);
ApplyFontSize;
end;
Recent
