forms - 表单大小调整时标签字体大小也随之调整

Question

我正在尝试获取它，以便当我调整表单大小时，该表单上的标签会相应地调整大小。对于值得的调整大小，仅在“WMExitSizeMove”过程触发时才会发生。编辑:我更喜欢一种缩放方法，它不会调整大小超出或低于限制

理想情况下，我想要的是根据表单增大或缩小的程度获得某种形式的“比例”值。然后我可以将此比例因子应用于表单/面板上的所有控件。

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

我有一个标签，我将它放在表单上，​​给它设置所有 anchor (左、右、上、下均为真)约束，以便控件看起来不会太小或太大。我希望标签文本大小在控件高度和宽度边界内尽可能大。我不希望当控件高度现在低于文本高度时发生剪切，此时我希望标签文本的大小调整为新控件高度下可能的最大尺寸。

示例标签.字体.大小 := 11;标签.高度 := 15;

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

理论上，下一个最佳的 label.font.size 是 9，因为这里没有发生裁剪。

如果您需要更多描述或更好的说明，请告诉我。最近这对我来说是皇家 PITA。

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

另外:我已经尝试过Calculate Max Font size我可能会错误地合并它，但是当我调整表单大小时，宽度是静态的，因为它似乎与文本宽度相关。

编辑:事实上，我认为规模方法是最好的，只是想不出我会如何做到这一点。看来我的数学有点粗糙!还必须符合限制。

Answer 1

仅在顶部和左侧使用 anchor 。然后在 WMExitSizeMove 消息过程中使用:Label1.Height := (Label1.Height * Height) div OldHeight; 和 Width 相同> 作为缩放系统。然后使用David的答案通过缩放来更新字体(使用pasteBin中从OP注释到答案的函数)。这对于简单的缩放系统来说非常有效。如果当仅宽度或高度变化时字体不缩放时让您感到困扰，那么您可以在这种情况下阻止标签缩放。

你会得到这样的结果:

以下代码将翻译为我所说的内容。

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仅当用户调整表单大小或移动表单时才会发送此消息。

Sent one time to a window, after it has exited the moving or sizing modal loop. The window enters the moving or sizing modal loop when the user clicks the window's title bar or sizing border, or when the window passes the WM_SYSCOMMAND message to the DefWindowProc function and the wParam parameter of the message specifies the SC_MOVE or SC_SIZE value. The operation is complete when DefWindowProc returns.