CODEWITHSUNDEEP
delphidevexpressdelphi-xe
Jens Borrisholt
Jens Borrisholt

Reputation: 6402

Calculate Max Font size

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?

Upvotes: 3

Views: 2520

Answers (2)

David Heffernan
David Heffernan

Reputation: 613272

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.

Upvotes: 5

MBo
MBo

Reputation: 80257

Text size doesn't depend linearly on font size. So you would better to increment or decrement font size by one and calculate text sizes, or find needed size with binary search (preferable, if size differs significantly)

Upvotes: 3

Related Questions