Label font resizing when form resizes

Question

I am trying to get it so when I resize a form the labels on that form resize accordingly.For what is worth the resize will only occur when the 'WMExitSizeMove' procedure triggers. Edit: I would prefer a scale aproach which wont resize beyond or beneath the constraints

Ideally what I would like is to get some form of 'scale' value based on how much the form has grown or shrunk. Then I could apply this scale factor to all controls on the form / panel.

I however will accept that labels font size will resize to the highest possible size of the label.heights property ( I would use width but that value doesn't seem to change ever as the caption is static).

I have a label, I place it onto the form, give it all anchors (left,right,top and bottom are all true) constraints are set so that the control won't look too small or big. I want the label text size to be as big as possible within the controls height and width boundaries. I don't want clipping to occur when the control height is now lower than the text height, at this point I want the resize of label text to go to the largest size possible under the new control height.

Example label.font.size := 11; Label.Height := 15;

Form resizes so label.height is 12

In theory the next best label.font.size would be 9 as no clipping occurs here.

If you would like more description or better clarification please let me know. This has been a royal PITA for me recently.

TLDR: Would like a form resize scale worked out so that I could apply that to all controls, otherwise a way to dynamically resize label.font.sizes to fit new heights / widths on resize.

Also: I have tried Calculate Max Font size I may be incorporating it wrong however when I resize forms the width is static as it seems linked to textwidth.

Edit: In fact I think the scale approach would be best, just can't think of how I'd do this. I am a bit rough on my maths it seems! Also has to fit within constraints.

Answer 1

Use the anchors only on the top and left. Then on the WMExitSizeMove message procedure use this: Label1.Height := (Label1.Height * Height) div OldHeight; and the same for the Width as a scaling system. then use David's answer to update the font with the scaling (use the function in the pasteBin from the OPs comment to the answer). this would work perfectly for a simple scaling system. And if it bothers you when the font does not scale when only the width or height changes then you can stop your label from scaling at that case.

You get this as a result:

the following code translates to what I said.

unit Unit12;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Math;

type
  TForm12 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure WMExitSizeMove(var aMessage: TMessage); message WM_ExitSizeMove;
  public
    { Public declarations }

  end;

var
  Form12: TForm12;
  OldWidth, OldHeight: Integer;
implementation

{$R *.dfm}

{ TForm12 }

function CalculateMazSize(aCanvas: TCanvas; aText: string; aWidth, aHeight: Integer): Integer;

  function LargestFontSizeToFitWidth(aCanvas: TCanvas; aText: string; aWidth: Integer): Integer;
  var
    Font: TFont;
    FontRecall: TFontRecall;
    InitialTextWidth: Integer;
  begin
    Font := aCanvas.Font;
    Result := Font.Size;
    FontRecall := TFontRecall.Create(Font);
    try
      InitialTextWidth := aCanvas.TextWidth(aText);
      Font.Size := MulDiv(Font.Size, aWidth, InitialTextWidth);

      if InitialTextWidth < aWidth then
        while True do
        begin
          Font.Size := Font.Size + 1;
          if aCanvas.TextWidth(aText) > aWidth then
            exit(Font.Size - 1);
        end;

      if InitialTextWidth > aWidth then
      begin
        while True do
        begin
          Font.Size := Font.Size - 1;
        if aCanvas.TextWidth(aText) <= aWidth then
          exit(Font.Size);
        end;
      end;
    finally
      FontRecall.Free;
    end;
  end;

  function LargestFontSizeToFitHeight(aCanvas: TCanvas; aText: string; aHeight: Integer): Integer;
  var
    Font: TFont;
    FontRecall: TFontRecall;
    InitialTextHeight: Integer;
  begin
    Font := aCanvas.Font;
    Result := Font.Size;
    FontRecall := TFontRecall.Create(Font);
    try
      InitialTextHeight := aCanvas.TextHeight(aText);
      Font.Size := MulDiv(Font.Size, aHeight, InitialTextHeight);

      if InitialTextHeight < aHeight then
        while True do
        begin
          Font.Size := Font.Size + 1;
          if aCanvas.TextHeight(aText) > aHeight then
            exit(Font.Size - 1);
        end;

      if InitialTextHeight > aHeight then
        while True do
        begin
          Font.Size := Font.Size - 1;
          if aCanvas.TextHeight(aText) <= aHeight then
            exit(Font.Size);
        end;

    finally
      FontRecall.Free;
    end;
  end;

begin
  if aText <> '' then
    Result := Min(LargestFontSizeToFitWidth(aCanvas, aText, aWidth),
                  LargestFontSizeToFitHeight(aCanvas, aText, aHeight))
  else
    Result := aCanvas.Font.Size;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
   OldWidth := Width;
   OldHeight := Height;
end;

procedure TForm12.WMExitSizeMove(var aMessage: TMessage);
begin
  // scaling
  Label1.Height := (Label1.Height * Height) div OldHeight;
  Label1.Width := (Label1.Width * Width) div OldWidth;
  // Updating font

  Label1.Font.Size := CalculateMazSize(Label1.Canvas, Label1.Caption, Label1.Width, Label1.Height);

  // Updating old values
  OldWidth := Width;
  OldHeight := Height;
end;

end.

One problem with this is if the user maximizes the form then it will not work because based on the documentation this message is only sent when the form is resized or moved by the user.

Sent one time to a window, after it has exited the moving or sizing modal loop. The window enters the moving or sizing modal loop when the user clicks the window's title bar or sizing border, or when the window passes the WM_SYSCOMMAND message to the DefWindowProc function and the wParam parameter of the message specifies the SC_MOVE or SC_SIZE value. The operation is complete when DefWindowProc returns.

Answer 2

i've modified David's function LargestFontSizeToFitWidth to calculate with height;

function LargestFontSizeToFitHeight(Canvas: TCanvas; Text: string; 
  height: Integer): Integer;
var
  Font: TFont;
  FontRecall: TFontRecall;
  InitialTextHeight: Integer;
begin
  Font := Canvas.Font;
  FontRecall := TFontRecall.Create(Font);
  try
    InitialTextHeight := Canvas.TextHeight(Text);
    Font.Size := MulDiv(Font.Size, height, InitialTextHeight);

    if InitialTextHeight < height then
    begin
      while True do
      begin
        Font.Size := Font.Size + 1;
        if Canvas.TextHeight(Text) > height then
        begin
          Result := Font.Size - 1;
          exit;
        end;
      end;
    end;

    if InitialTextHeight > height then
    begin
      while True do
      begin
        Font.Size := Font.Size - 1;
        if Canvas.TextHeight(Text) <= height then
        begin
          Result := Font.Size;
          exit;
        end;
      end;
    end;
  finally
    FontRecall.Free;
  end;
end;

and use them in resize event of form;

procedure TForm1.FormResize(Sender: TObject);
 var
  x,y:Integer;
begin
  x := LargestFontSizeToFitHeight(Label1.Canvas, Label1.Caption, Label1.Height);
  y := LargestFontSizeToFitWidth(Label1.Canvas, Label1.Caption, Label1.Width);  // David's original function
  if x > y then
    x := y;
  Label1.Font.Size := x;
end;