Recent

Author Topic: [SOLVED] anchors auto resize  (Read 14483 times)

derek.john.evans

  • Guest
Re: [SOLVED] anchors auto resize
« Reply #15 on: September 27, 2015, 04:50:25 pm »
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  [Select][+][-]
  1. procedure TForm1.FormResize(Sender: TObject);
  2. begin
  3.   WinControlProportionalResizer(Self);
  4. end;    
  5.  

Code: Pascal  [Select][+][-]
  1. procedure WinControlProportionalResizer(const AParent: TWinControl);
  2. var
  3.   LReadBounds, LParentReadBounds: TRect;
  4.   LIndex, LReadWidth, LReadHeight, LParentReadWidth, LParentReadHeight: Integer;
  5.   LControl: TControl;
  6. begin
  7.   for LIndex := 0 to AParent.ControlCount - 1 do begin
  8.     LControl := AParent.Controls[LIndex];
  9.     if LControl.Align = alNone then begin
  10.       LReadBounds := LControl.ReadBounds;
  11.       LReadWidth := LReadBounds.Right - LReadBounds.Left;
  12.       LReadHeight := LReadBounds.Bottom - LReadBounds.Top;
  13.       LParentReadBounds := AParent.ReadBounds;
  14.       LParentReadWidth := LParentReadBounds.Right - LParentReadBounds.Left;
  15.       LParentReadHeight := LParentReadBounds.Bottom - LParentReadBounds.Top;
  16.       LControl.SetBounds(LReadBounds.Left * AParent.Width div LParentReadWidth,
  17.         LReadBounds.Top * AParent.Height div LParentReadHeight,
  18.         LReadWidth * AParent.Width div LParentReadWidth,
  19.         LReadHeight * AParent.Height div LParentReadHeight);
  20.       if LControl is TCustomButton then begin
  21.         LControl.Font.Height := LControl.Height - 2;
  22.       end;
  23.     end;
  24.   end;
  25. end;  
  26.  

Note: I'm not sure I coded the same font sizing, but, anyway, see what you think.
« Last Edit: October 02, 2015, 02:58:51 am by Geepster »

AlphaInc.

  • Jr. Member
  • **
  • Posts: 93
Re: [SOLVED] anchors auto resize
« Reply #16 on: April 22, 2021, 12:22:57 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: [Select]
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;

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: [Select]
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;



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.

 

TinyPortal © 2005-2018