Delphi – calculate maximum font size

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

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

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;

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  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;

I am calculating the maximum font size so that Text fits TCxLabel ClientRect. But I may not be able to get it to work. (See picture)

The fontsize is large and the thxt is not drawn to the correct position.

Here is how to reproduce:< /p>

Put tcxLabel on the empty form and align the label to the client

Add FormCreate and FormResize events:

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

procedure TForm48.FormResize(Sender: TObject);
begin< br /> CalculateNewFontSize;
end;

Finally realize CalculateNewFontSize:

Use
mathematics;

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

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

 c xLabel1.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 anyone know how to calculate the font size and ho to place the text correctly?

I will use something along these directions:

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  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;< br /> end;
end;

Make an initial estimate, and then modify the size by increasing the size one at a time. This is easy to understand and verify that it is correct, and very effective. In typical use , The code will only call TextWidth a few times.