计算最大字体大小

Question

我正在尝试计算最大字体大小，以便 at Text 适合 TCxLabel 的 ClientRect。但我可能无法让它工作。（见图）

字体太大，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;

有谁知道如何计算字体大小以及如何正确放置文本？

Answer 1

文本大小与字体大小不成线性关系。所以你最好将字体大小增加或减少一个并计算文本大小，或者使用二进制搜索找到所需的大小（最好，如果大小差异很大）

Answer 2

我会按照这些思路使用一些东西：

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 几次。

计算最大字体大小

Calculate Max Font size

delphi

devexpress

delphi-xe