Calculate Max Font size

Question

I'm tyring calculate the maximum fontsize in order for at Text to fit into the ClientRect of a TCxLabel. But I cant get it to work probably. (See picture)

enter image description here

The fontsize is to big and the thxt is not drawn the corrent place.

Here how to reproduce:

Place a tcxLabel on an empty Form, and allign the label to client

Add a FormCreate and a FormResize event :

procedure TForm48.FormCreate(Sender: TObject);
begin
  CalculateNewFontSize;
end;

procedure TForm48.FormResize(Sender: TObject);
begin
  CalculateNewFontSize;
end;

and Finally implement CalculateNewFontSize :

uses Math;

procedure TForm48.CalculateNewFontSize;
var
  ClientSize, TextSize: TSize;
begin

  ClientSize.cx := cxLabel1.Width;
  ClientSize.cy := cxLabel1.Height;

  cxLabel1.Style.Font.Size := 10;
  TextSize := cxLabel1.Canvas.TextExtent(Text);

  if TextSize.cx * TextSize.cx = 0 then
    exit;

  cxLabel1.Style.Font.Size := cxLabel1.Style.Font.Size * Trunc(Min(ClientSize.cx / TextSize.cx, ClientSize.cy / TextSize.cy) + 0.5);
end;

Does any one know how to calculate the font size and ho to place the text correctly?

cxLabel1.Style.Font.Size := cxLabel1.Style.Font.Size * n where n is an integer means you don't cover the font size space at all well. — David Heffernan
Since Font.Size is an integer I need n to be an integer as well !?! — Jens Borrisholt
So if you start with a size of 12 then you believe that the next larger value is 24? Use MulDiv. — David Heffernan
See also How to autodraw the text based on graphiccontrols size. — NGLN

David Heffernan David Heffernan · Accepted Answer · 2015-02-23T09:15:49

I'd use something along these lines:

function LargestFontSizeToFitWidth(Canvas: TCanvas; Text: string; 
  Width: Integer): Integer;
var
  Font: TFont;
  FontRecall: TFontRecall;
  InitialTextWidth: Integer;
begin
  Font := Canvas.Font;
  FontRecall := TFontRecall.Create(Font);
  try
    InitialTextWidth := Canvas.TextWidth(Text);
    Font.Size := MulDiv(Font.Size, Width, InitialTextWidth);

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

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

Make an initial estimate, and then fine tune by modifying the size by increments of one at a time. This is easy to understand and verify for correctness, and also quite efficient. In typical use the code will call TextWidth only a handful of times.

Calculate Max Font size

2 Answers