如何计算在Delphi中支持的最大字体尺寸？

本文共计417个文字，预计阅读时间需要2分钟。

我在尝试计算最大字体的尺寸，以便Text适合TCxLabel的ClientRect。但似乎无法让它工作。（见图）问题在于fontsize太大，而thxt没有绘制到正确的位置。这里如何重现：将tcxLabel放在窗口体上，并将标签对齐到。

我正在计算最大字体大小,以便Text适合TCxLabel的ClientRect.但我可能无法让它工作. (见图)

fontsize是大而且thxt没有绘制到正确的位置.

这里如何重现：

将tcxLabel放在空窗体上,并将标签对齐到客户端

添加FormCreate和FormResize事件：

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

最后实现CalculateNewFontSize：

使用
数学;

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;

有没有人知道如何计算字体大小和ho正确放置文本？

我会沿着这些方向使用一些东西：

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;

进行初始估计,然后通过一次增加一个大小来修改大小.这很容易理解和验证是否正确,而且非常有效.在典型的使用中,代码只会调用几次TextWidth.