Delphi 计算最大字体大小

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

字体太大，文字没有画在正确的地方

以下是如何复制：

在空表单上放置一个tcxLabel，并将标签全部标记到客户端

添加FormCreate和FormResize事件：

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

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

最后实现CalculateNewFontSize：

使用 数学

---

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

文本大小与字体大小没有线性关系。因此，您最好将字体大小增加或减少1，然后计算文本大小，或者通过二进制搜索查找所需的大小（如果大小差异很大，则更可取）

我将使用以下方法：

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;

函数LargestFontSizeToFitWidth（画布：TCanvas；文本：字符串；
宽度：整数）：整数；
变量
字体：TFont；
FontRecall:Tfontecall；
InitialTextWidth：整数；
开始
Font:=Canvas.Font；
FontRecall:=tfontecall.Create（字体）；
尝试
InitialTextWidth:=Canvas.TextWidth（文本）；
Font.Size:=MulDiv（Font.Size，Width，InitialTextWidth）；
如果InitialTextWidth宽度，则
开始
结果：=字体大小-1；
出口
结束；
结束；
结束；
如果InitialTextWidth>Width，则
开始
尽管如此
开始
Font.Size:=Font.Size-1；
如果Canvas.TextWidth（Text）
cxLabel1.Style.Font.Size:=cxLabel1.Style.Font.Size*n
其中
n
是一个整数，则表示您完全没有覆盖字体大小空间。由于Font.Size是一个整数，因此我需要n也是一个整数！？！如果你从12开始，那么你认为下一个更大的值是24？使用MulDiv。另请参见。是的，这是我的第一个解决方案，但我更喜欢纯数学这个问题（对于非单空格字体）不能用纯数学解决，因为不同字体元素（字母元素、符号间空格等）的大小以复杂的方式变化。例如，ligature（example-connected ff）可以用于某些字体大小，而Diapears可以用于其他大小。感谢您的帮助David我根据您的代码制作了我的组件，我只想与您和世界其他人分享结果：D@Kromster我想它一定是一个类，在销毁时，恢复传递给构造函数的字体的原始属性
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;