Question

我正试图这样做，所以当我调整表单大小时，表单上的标签会相应地调整大小。对于什么值得调整大小只会出现在＆＃39; WMExitSizeMove＆＃39;程序触发器。编辑：我更喜欢一个不会在约束之外或之下重新调整大小的方法

理想情况下，我想要的是获得某种形式的缩放＆＃39;价值取决于形式增长或缩小的程度。然后我可以将此比例因子应用于表单/面板上的所有控件。

但是我会接受标签字体大小将调整为label.heights属性的最大可能大小（我会使用宽度，但该值似乎不会随着标题是静态而改变）。

我有一个标签，我把它放在表格上，给它所有的锚点（左，右，顶部和底部都是真的）设置约束，使控件看起来不会太小或太大。我希望标签文本大小在控件高度和宽度边界内尽可能大。当控制高度现在低于文本高度时，我不希望发生裁剪，此时我希望标签文本的大小调整到新控制高度下可能的最大尺寸。

实施例 label.font.size：= 11; Label.Height：= 15;

表单调整大小，因此label.height为12

理论上，下一个最好的label.font.size是9，因为这里没有剪辑。

如果您想了解更多说明或更好的说明，请告知我们。这对我来说是最近的皇家PITA。

TLDR：希望表单调整大小，以便我可以将其应用于所有控件，否则可以动态调整label.font.sizes的大小以适应调整大小时的新高度/宽度。

另外：我已经尝试Calculate Max Font size我可能会将其合并错误但是当我调整表单时，宽度是静态的，因为它似乎与textwidth相关联。

编辑：事实上，我认为规模方法是最好的，只是不能想到我是如何做到这一点的。看起来我的数学有点粗糙！还必须符合约束条件。

Answer 1

仅在顶部和左侧使用锚点。然后在WMExitSizeMove消息过程中使用此Label1.Height := (Label1.Height * Height) div OldHeight;，并将Width与缩放系统相同。然后使用David的答案通过缩放更新字体（使用从OPs注释到答案的pasteBin中的函数）。这对于简单的缩放系统非常有效。如果只有当宽度或高度发生变化时字体不能缩放时会让您感到烦恼，那么在这种情况下您可以阻止标签缩放。

结果就是这样：

以下代码转换为我所说的内容。

unit Unit12;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Math;

type
  TForm12 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure WMExitSizeMove(var aMessage: TMessage); message WM_ExitSizeMove;
  public
    { Public declarations }

  end;

var
  Form12: TForm12;
  OldWidth, OldHeight: Integer;
implementation

{$R *.dfm}

{ TForm12 }

function CalculateMazSize(aCanvas: TCanvas; aText: string; aWidth, aHeight: Integer): Integer;

  function LargestFontSizeToFitWidth(aCanvas: TCanvas; aText: string; aWidth: Integer): Integer;
  var
    Font: TFont;
    FontRecall: TFontRecall;
    InitialTextWidth: Integer;
  begin
    Font := aCanvas.Font;
    Result := Font.Size;
    FontRecall := TFontRecall.Create(Font);
    try
      InitialTextWidth := aCanvas.TextWidth(aText);
      Font.Size := MulDiv(Font.Size, aWidth, InitialTextWidth);

      if InitialTextWidth < aWidth then
        while True do
        begin
          Font.Size := Font.Size + 1;
          if aCanvas.TextWidth(aText) > aWidth then
            exit(Font.Size - 1);
        end;

      if InitialTextWidth > aWidth then
      begin
        while True do
        begin
          Font.Size := Font.Size - 1;
        if aCanvas.TextWidth(aText) <= aWidth then
          exit(Font.Size);
        end;
      end;
    finally
      FontRecall.Free;
    end;
  end;

  function LargestFontSizeToFitHeight(aCanvas: TCanvas; aText: string; aHeight: Integer): Integer;
  var
    Font: TFont;
    FontRecall: TFontRecall;
    InitialTextHeight: Integer;
  begin
    Font := aCanvas.Font;
    Result := Font.Size;
    FontRecall := TFontRecall.Create(Font);
    try
      InitialTextHeight := aCanvas.TextHeight(aText);
      Font.Size := MulDiv(Font.Size, aHeight, InitialTextHeight);

      if InitialTextHeight < aHeight then
        while True do
        begin
          Font.Size := Font.Size + 1;
          if aCanvas.TextHeight(aText) > aHeight then
            exit(Font.Size - 1);
        end;

      if InitialTextHeight > aHeight then
        while True do
        begin
          Font.Size := Font.Size - 1;
          if aCanvas.TextHeight(aText) <= aHeight then
            exit(Font.Size);
        end;

    finally
      FontRecall.Free;
    end;
  end;

begin
  if aText <> '' then
    Result := Min(LargestFontSizeToFitWidth(aCanvas, aText, aWidth),
                  LargestFontSizeToFitHeight(aCanvas, aText, aHeight))
  else
    Result := aCanvas.Font.Size;
end;

procedure TForm12.FormCreate(Sender: TObject);
begin
   OldWidth := Width;
   OldHeight := Height;
end;

procedure TForm12.WMExitSizeMove(var aMessage: TMessage);
begin
  // scaling
  Label1.Height := (Label1.Height * Height) div OldHeight;
  Label1.Width := (Label1.Width * Width) div OldWidth;
  // Updating font

  Label1.Font.Size := CalculateMazSize(Label1.Canvas, Label1.Caption, Label1.Width, Label1.Height);

  // Updating old values
  OldWidth := Width;
  OldHeight := Height;
end;

end.

这样做的一个问题是，如果用户最大化表单，那么它将无法工作，因为基于the documentation此消息仅在用户调整表单大小或移动时发送。

在退出移动或调整大小后，向窗口发送一次模态循环。窗口进入移动或尺寸调整模态循环时用户点击窗口的标题栏或调整边框，或者窗口将WM_SYSCOMMAND消息传递给DefWindowProc函数并且消息的wParam参数指定SC_MOVE或 SC_SIZE值。当DefWindowProc返回时，操作完成。

Answer 2

我修改了David's function LargestFontSizeToFitWidth来计算身高;

function LargestFontSizeToFitHeight(Canvas: TCanvas; Text: string; 
  height: Integer): Integer;
var
  Font: TFont;
  FontRecall: TFontRecall;
  InitialTextHeight: Integer;
begin
  Font := Canvas.Font;
  FontRecall := TFontRecall.Create(Font);
  try
    InitialTextHeight := Canvas.TextHeight(Text);
    Font.Size := MulDiv(Font.Size, height, InitialTextHeight);

    if InitialTextHeight < height then
    begin
      while True do
      begin
        Font.Size := Font.Size + 1;
        if Canvas.TextHeight(Text) > height then
        begin
          Result := Font.Size - 1;
          exit;
        end;
      end;
    end;

    if InitialTextHeight > height then
    begin
      while True do
      begin
        Font.Size := Font.Size - 1;
        if Canvas.TextHeight(Text) <= height then
        begin
          Result := Font.Size;
          exit;
        end;
      end;
    end;
  finally
    FontRecall.Free;
  end;
end;

并在表单的resize事件中使用它们;

procedure TForm1.FormResize(Sender: TObject);
 var
  x,y:Integer;
begin
  x := LargestFontSizeToFitHeight(Label1.Canvas, Label1.Caption, Label1.Height);
  y := LargestFontSizeToFitWidth(Label1.Canvas, Label1.Caption, Label1.Width);  // David's original function
  if x > y then
    x := y;
  Label1.Font.Size := x;
end;

表单调整大小

2 个答案: