[SOLVED] anchors auto resize

Forum > Designer

<< < (4/4)

derek.john.evans:
Interesting concept. Here is an alternative to caching percentages for each control. You can use TControl.ReadBounds to get the original bounds of the control.

Usage:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TForm1.FormResize(Sender: TObject);begin WinControlProportionalResizer(Self);end;

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure WinControlProportionalResizer(const AParent: TWinControl);var LReadBounds, LParentReadBounds: TRect; LIndex, LReadWidth, LReadHeight, LParentReadWidth, LParentReadHeight: Integer; LControl: TControl;begin for LIndex := 0 to AParent.ControlCount - 1 do begin LControl := AParent.Controls[LIndex]; if LControl.Align = alNone then begin LReadBounds := LControl.ReadBounds; LReadWidth := LReadBounds.Right - LReadBounds.Left; LReadHeight := LReadBounds.Bottom - LReadBounds.Top; LParentReadBounds := AParent.ReadBounds; LParentReadWidth := LParentReadBounds.Right - LParentReadBounds.Left; LParentReadHeight := LParentReadBounds.Bottom - LParentReadBounds.Top; LControl.SetBounds(LReadBounds.Left * AParent.Width div LParentReadWidth, LReadBounds.Top * AParent.Height div LParentReadHeight, LReadWidth * AParent.Width div LParentReadWidth, LReadHeight * AParent.Height div LParentReadHeight); if LControl is TCustomButton then begin LControl.Font.Height := LControl.Height - 2; end; end; end;end;
Note: I'm not sure I coded the same font sizing, but, anyway, see what you think.

AlphaInc.:

--- Quote from: mercury on September 27, 2015, 02:44:31 pm ---
--- Quote from: howardpc on September 19, 2015, 07:28:21 pm ---A possible approach would be to drop a label somewhere on your form named LDummy, and then use some variation on the following:

--- Code: ---procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
LDummy.Left:=ClientWidth + 1;
SetLength(AutoZoom, Self.ControlCount, 4);
for i := 0 to Self.ControlCount - 1 do
begin
AutoZoom[i][0] := Self.Controls[i].Top / Self.Height;
AutoZoom[i][1] := Self.Controls[i].Left / Self.Width;
AutoZoom[i][2] := Self.Controls[i].Width / Self.Width;
AutoZoom[i][3] := Self.Controls[i].Height / Self.Height;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
var
i, initialSize: integer;

procedure AdjustFontSize(aLabelHeight: integer);
var
textHeight: byte;
targetHeight: byte;
begin
textHeight:=LDummy.Canvas.TextHeight(LDummy.Caption);
targetHeight:=aLabelHeight;
if (textHeight < targetHeight) then
repeat
LDummy.Font.Size:=LDummy.Font.Size + 1;
textHeight:=LDummy.Canvas.TextHeight(LDummy.Caption);
until (textHeight in [Pred(targetHeight), targetHeight, Succ(targetHeight)])
else if (textHeight > targetHeight) then
repeat
LDummy.Font.Size:=LDummy.Font.Size - 1;
textHeight:=LDummy.Canvas.TextHeight(LDummy.Caption);
until (textHeight in [Pred(targetHeight), targetHeight, Succ(targetHeight)])
end;

begin
DisableAlign;
for i := 0 to Form1.ControlCount - 1 do
begin
Self.Controls[i].Top := Round(AutoZoom[i][0] * Self.Height);
Self.Controls[i].Left := Round(AutoZoom[i][1] * Self.Width);
Self.Controls[i].Width := Round(AutoZoom[i][2] * Self.Width);
Self.Controls[i].Height := Round(AutoZoom[i][3] * Self.Height);
end;
initialSize:=LDummy.Font.Size;
if (LDummy.Height <> LDummy.Canvas.TextHeight(LDummy.Caption)) then
AdjustFontSize(LDummy.Height);
if (LDummy.Font.Size <> initialSize) then
for i:=0 to form1.ControlCount-1 do
if (Controls[i] <> LDummy) then
Controls[i].Font.Size:=LDummy.Font.Size;
EnableAlign;
end;

--- End code ---

--- End quote ---

Sorry, I don't understand your code.
It doesn't work for me.
The font size keep growing when I resize the form, no matter the form is big or small.
And why call DisableAlign? Is that matter?

BTW, I think this way is easier.
@dsw1

--- Code: ---var
Form1: TForm1;
AutoZoom: array of array of real;
FormAspect: real;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
i, j: integer;
begin
FormAspect := Self.Width / Self.Height;
SetLength(AutoZoom, Self.ControlCount, 6);
for i := 0 to Self.ControlCount - 1 do
begin
AutoZoom[i][0] := Self.Controls[i].Top / Self.Height;
AutoZoom[i][1] := Self.Controls[i].Left / Self.Width;
AutoZoom[i][2] := Self.Controls[i].Width / Self.Width;
AutoZoom[i][3] := Self.Controls[i].Height / Self.Height;
if Self.Controls[i].Font.Height = 0 then
Self.Controls[i].Font.Height := 24;
AutoZoom[i][4] := Self.Controls[i].Font.Height / Self.Width;
AutoZoom[i][5] := Self.Controls[i].Font.Height / Self.Height;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
var
i: integer;
begin
for i := 0 to Form1.ControlCount - 1 do
begin
Self.Controls[i].Top := Round(AutoZoom[i][0] * Self.Height);
Self.Controls[i].Left := Round(AutoZoom[i][1] * Self.Width);
Self.Controls[i].Width := Round(AutoZoom[i][2] * Self.Width);
Self.Controls[i].Height := Round(AutoZoom[i][3] * Self.Height);
if Self.Width / Self.Height < FormAspect then
Self.Controls[i].Font.Height := Round(AutoZoom[i][4] * Self.Width)
else
Self.Controls[i].Font.Height := Round(AutoZoom[i][4] * Self.Height);
end;
end;

--- End code ---

--- End quote ---

Hey, I know it's been a long time since the last reply in this topic but do you happen to know how to apply this on a TNotebook? Whenever I scale it, the buttons on a TNotebook Page stay fixed and therefore are out of the screen.

Navigation

[0] Message Index

[*] Previous page