当Windows字体缩放大于100％时，如何使我的GUI表现良好

Question

在Windows控制面板中选择较大的字体大小（例如125％或150％）时，每次以像素方式设置某些内容时，VCL应用程序中都会出现问题。

取TStatusBar.Panel。我已经设置了它的宽度，使它只包含一个标签，现在使用大字体标签“溢出”。与其他组件相同的问题。

戴尔的一些新笔记本电脑已经默认设置为125％，因此在过去这个问题非常罕见，现在非常重要。

可以采取哪些措施来解决这个问题？

Answer 1

只要Scaled为True，.dfm文件中的设置就会正确扩展。

如果您要在代码中设置维度，则需要按Screen.PixelsPerInch除以Form.PixelsPerInch进行缩放。使用MulDiv执行此操作。

function TMyForm.ScaleDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, PixelsPerInch);
end;

这是表单持久性框架在Scaled为True时所执行的操作。

事实上，您可以使用一个为分母硬编码值96的版本来替换此函数。这允许您使用绝对维度值，如果您碰巧在开发计算机上更改字体缩放并重新保存.dfm文件，则不必担心意义更改。重要的是，存储在.dfm文件中的PixelsPerInch属性是上次保存.dfm文件的机器的值。

const
  SmallFontsPixelsPerInch = 96;

function ScaleFromSmallFontsDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, SmallFontsPixelsPerInch);
end;

因此，继续主题，另一件需要警惕的事情是，如果您的项目是在具有不同DPI值的多台计算机上开发的，您会发现Delphi在保存.dfm文件时使用的缩放导致控件在系列编辑。在我的工作地点，为了避免这种情况，我们有一个严格的政策，表格只能以96dpi编辑（100％缩放）。

实际上，我的ScaleFromSmallFontsDimension版本也允许表单字体在运行时与设计时设置字体不同的可能性。在XP机器上，我的应用程序的表单使用8pt Tahoma。在Vista和9pt上使用Segoe UI。这提供了另一个自由度。缩放必须考虑到这一点，因为源代码中使用的绝对尺寸值被假定为相对于96dpi时8pt Tahoma的基线。

如果您在UI中使用任何图像或字形，那么这些也需要扩展。一个常见的例子是工具栏和菜单上使用的字形。您希望将这些字形作为链接到可执行文件的图标资源提供。每个图标应包含一系列大小，然后在运行时选择最合适的大小并将其加载到图像列表中。有关该主题的一些详细信息，请访问：How do I load icons from a resource without suffering from aliasing?

另一个有用的技巧是相对于TextWidth或TextHeight以相对单位定义维度。因此，如果您想要大约10条垂直线的大小，可以使用10*Canvas.TextHeight('Ag')。这是一个非常粗略和准备好的指标，因为它不允许行间距等。但是，您通常需要做的就是安排GUI使用PixelsPerInch正确缩放。

您还应将自己的应用标记为high DPI aware。执行此操作的最佳方法是通过应用程序清单。由于Delphi的构建工具不允许您自定义您使用的清单，因此强制您链接自己的清单资源。

<?xml version='1.0' encoding='UTF-8' standalone='yes'?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
    <asmv3:windowsSettings
         xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>true</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
</assembly>

资源脚本如下所示：

1 24 "Manifest.txt"

其中Manifest.txt包含实际的清单。您还需要包含comctl32 v6部分，并将requestedExecutionLevel设置为asInvoker。然后，您将此编译的资源链接到您的应用程序，并确保Delphi不会尝试对其清单执行相同操作。在现代Delphi中，您可以通过将Runtime Themes项目选项设置为None来实现这一目的。

清单是正确的方式，用于声明您的应用具有高DPI感知能力。如果您只想快速尝试而不弄乱您的清单，请致电SetProcessDPIAware。这样做是应用程序运行时的第一件事。最好是在早期单元初始化部分之一中，或者作为.dpr文件中的第一部分。

如果您没有宣布您的应用具有高DPI感知能力，那么Vista和更高版本将使其处于传统模式，以便任何字体缩放超过125％。这看起来非常可怕。尽量避免陷入陷阱。

每个监视器DPI更新的Windows 8.1

从Windows 8.1开始，现在支持每个监视器的DPI设置（http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx）。对于可能具有不同显示器的现代设备来说，这是一个很大的问题。您可能拥有非常高的DPI笔记本电脑屏幕和低DPI外部投影仪。支持这样的场景需要比上述更多的工作。

Answer 2

注意：请参阅其他答案，因为它们包含非常有价值的技巧。我在这里的回答只提供了一些警告和警告，反对假设DPI意识很容易。

我通常使用TForm.Scaled = True来避免DPI感知缩放。 DPI意识对我来说非常重要，因为对于打电话给我并愿意为此付费的客户而言，它很重要。这种观点背后的技术原因是DPI意识与否，你正在打开一扇窗户进入一个受伤的世界。许多标准和第三方VCL控件在高DPI中不能很好地工作。包含Windows公共控件的VCL部件在高DPI下工作得非常好。大量的第三方和内置Delphi VCL自定义控件在高DPI下无法正常工作，或根本无法工作。如果您打算打开TForm.Scaled，请确保为项目中的每个表单以及您使用的每个第三方和内置控件测试96,125和150 DPI。

Delphi本身是用Delphi编写的。对于大多数表单，它具有高DPI感知标志，尽管即使在最近的Delphi XE2中，IDE作者自己也决定不打开高DPI感知清单标志。请注意，在Delphi XE4及更高版本中，HIGH DPI感知标志已打开，IDE看起来很好。

我建议您不要使用TForm.Scaled = true（这是Delphi中的默认值，因此除非您已经修改了它，大多数表单都有Scaled = true）并带有高DPI感知标记（如David所示）使用内置的delphi表单设计器构建的VCL应用程序。

我曾经尝试过在TForm.Scaled为真的情况下制作一个你可以期待看到的那种破损的最小样本，当Delphi形式缩放时有一个小故障。这些故障并不总是仅由96以外的DPI值触发。我无法确定其他内容的完整列表，包括Windows XP字体大小更改。但由于大多数这些故障只出现在我自己的应用程序中，在相当复杂的情况下，我已经决定向您展示一些可以验证自己的证据。

当您在Windows 7中将DPI Scaling设置为“Fonts @ 200％”时，Delphi XE看起来像这样，并且在Windows 7和8上类似地破坏了Delphi XE2，但是这些故障似乎是在Delphi XE4中修复的：< / p>

这些主要是标准VCL控制，在高DPI时行为不端。请注意，大多数事情都没有扩展，因此Delphi IDE开发人员决定忽略DPI感知，并关闭DPI虚拟化。这样一个有趣的选择。

只有在想要这种新的额外痛苦来源和困难的选择时，才能关闭DPI虚拟化。我建议你不要管它。请注意，Windows常用控件似乎工作正常。请注意，Delphi数据资源管理器控件是围绕标准Windows树公共控件的C＃WinForms包装器。这是一个纯粹的微软故障，修复它可能要求Embarcadero为其数据资源管理器重写纯粹的原生.Net树控件，或者编写一些DPI检查和修改属性代码来更改控件中的项高度。即使是微软的WinForms也无法自动处理高DPI，无需自定义kludge代码。

更新：有趣的事实：虽然delphi IDE似乎不是“虚拟化”，但它没有使用David显示的清单内容来实现“非DPI虚拟化”。也许它在运行时使用了一些API函数。

更新2：为了回应我如何支持100％/ 125％DPI，我会提出一个两阶段计划。阶段1是清点我的代码以获取需要针对高DPI修复的自定义控件，然后制定计划来修复它们或逐步淘汰它们。第2阶段是将我的代码的某些区域设计为没有布局管理的表单，并将它们更改为使用某种布局管理的表单，以便DPI或字体高度更改可以在不剪切的情况下工作。我怀疑这种“控制间”布局工作在大多数应用程序中要比“内部控制”工作复杂得多。

更新：2016年，最新的Delphi 10.1 Berlin在我的150 dpi工作站上运行良好。

Answer 3

同样重要的是要注意，尊重用户的DPI只是您实际工作的一部分：

  

尊重用户的字体大小

几十年来，Windows使用对话框单元而不是像素执行布局这一概念解决了这个问题。定义“对话框单元”，以便字体的平均字符为

• 4个对话框单元（dlus）宽，
• 8个对话框单元（clus）high

Delphi确实附带{bug}概念Scaled，其中表单会尝试根据

自动调整

• 用户的Windows DPI设置，经文
• 上次保存表单的开发人员的计算机上的DPI设置

当用户使用与您设计表单的字体不同的字体时，这并不能解决问题，例如：

• 开发人员使用 MS Sans Serif 8pt 设计表单（其中平均字符为6.21px x 13.00px，为96dpi）

• 使用 Tahoma 8pt 运行的用户（其中​​平均字符为5.94px x 13.00px，为96dpi）

  与开发Windows 2000或Windows XP应用程序的任何人一样。

或

• 开发人员使用** Tahoma 8pt *设计表单（其中平均字符为5.94px x 13.00px，为96dpi）
• 使用 Segoe UI 9pt 运行的用户（其中​​平均字符为6.67px x 15px，为96dpi）

作为一名优秀的开发者，您将尊重用户的字体首选项。这意味着您还需要缩放表单上的所有控件以匹配新的字体大小：

• 将所有内容水平扩展12.29％（6.67 / 5.94）
• 将所有内容垂直拉伸15.38％（15/13）

Scaled不会为您处理此事。

以下情况变得更糟：

• 在 Segoe UI 9pt 设计了您的表单（Windows Vista，Windows 7，Windows 8默认设置）
• 用户正在运行 Segoe UI 14pt ，（例如我的偏好），即10.52px x 25px

现在你必须扩展一切

• 水平57.72％
• 垂直方向66.66％

Scaled不会为您处理此事。

---

如果你很聪明，你可以看到DPI是多么的无可挑剔：

• 使用Segoe UI设计的9pt @ 96dpi（6.67px x 15px）
• 使用Segoe UI 9pt运行的用户@ 150dpi（10.52px x 25px）

您不应该查看用户的DPI设置，您应该查看他们的字体大小。两个用户正在运行

• Segoe UI 14pt @ 96dpi（10.52px x 25px）
• Segoe UI 9pt @ 150dpi（10.52px x 25px）

正在运行相同的字体。 DPI只是 一个 影响字体大小的东西;用户的偏好是另一个。

StandardizeFormFont

Clovis注意到我引用了一个函数StandardizeFormFont来修复表单上的字体，并将其缩放到新的字体大小。它不是一个标准函数，而是一整套函数，它们完成了Borland从未处理过的简单任务。

function StandardizeFormFont(AForm: TForm): Real;
var
    preferredFontName: string;
    preferredFontHeight: Integer;
begin
    GetUserFontPreference({out}preferredFontName, {out}preferredFontHeight);

    //e.g. "Segoe UI",     
    Result := Toolkit.StandardizeFormFont(AForm, PreferredFontName, PreferredFontHeight);
end;

Windows有6种不同的字体; Windows中没有单一的“字体设置” 但我们从经验中知道，我们的表单应该遵循图标标题字体设置

procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
   font: TFont;
begin
   font := Toolkit.GetIconTitleFont;
   try
      FaceName := font.Name; //e.g. "Segoe UI"

      //Dogfood testing: use a larger font than we're used to; to force us to actually test it    
      if IsDebuggerPresent then
         font.Size := font.Size+1;

      PixelHeight := font.Height; //e.g. -16
   finally
      font.Free;
   end;
end;

一旦我们知道字体大小，我们会将表单缩放为到，我们会得到表单的当前字体高度（以像素为单位），并按该因子进行扩展。< / p>

例如，如果我将表单设置为 -16 ，表单目前位于 -11 ，那么我们需要进行扩展整个表格由：

-16 / -11 = 1.45454%

标准化分两个阶段进行。首先按新旧字体大小的比例缩放表单。然后实际更改控件（递归）以使用新字体。

function StandardizeFormFont(AForm: TForm; FontName: string; FontHeight: Integer): Real;
var
    oldHeight: Integer;
begin
    Assert(Assigned(AForm));

    if (AForm.Scaled) then
    begin
        OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to Scaled. Proper form scaling requires VCL scaling to be disabled, unless you implement scaling by overriding the protected ChangeScale() method of the form.'));
    end;

    if (AForm.AutoScroll) then
    begin
        if AForm.WindowState = wsNormal then
        begin
            OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to AutoScroll. Form designed size will be suseptable to changes in Windows form caption height (e.g. 2000 vs XP).'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
        end;
    end;

    if (not AForm.ShowHint) then
    begin
        AForm.ShowHint := True;
        OutputDebugString(PChar('INFORMATION: StandardizeFormFont: Turning on form "'+GetControlName(AForm)+'" hints. (ShowHint := True)'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
    end;

    oldHeight := AForm.Font.Height;

    //Scale the form to the new font size
//  if (FontHeight <> oldHeight) then    For compatibility, it's safer to trigger a call to ChangeScale, since a lot of people will be assuming it always is called
    begin
        ScaleForm(AForm, FontHeight, oldHeight);
    end;

    //Now change all controls to actually use the new font
    Toolkit.StandardizeFont_ControlCore(AForm, g_ForceClearType, FontName, FontHeight,
            AForm.Font.Name, AForm.Font.Size);

    //Return the scaling ratio, so any hard-coded values can be multiplied
    Result := FontHeight / oldHeight;
end;

这是实际缩放表单的工作。它适用于Borland自己的Form.ScaleBy方法中的错误。首先，它必须禁用表单上的所有锚点，然后执行缩放，然后重新启用锚点：

TAnchorsArray = array of TAnchors;

procedure ScaleForm(const AForm: TForm; const M, D: Integer);
var
    aAnchorStorage: TAnchorsArray;
    RectBefore, RectAfter: TRect;
    x, y: Integer;
    monitorInfo: TMonitorInfo;
    workArea: TRect;
begin
    if (M = 0) and (D = 0) then
        Exit;

    RectBefore := AForm.BoundsRect;

    SetLength(aAnchorStorage, 0);
    aAnchorStorage := DisableAnchors(AForm);
    try
        AForm.ScaleBy(M, D);
    finally
        EnableAnchors(AForm, aAnchorStorage);
    end;

    RectAfter := AForm.BoundsRect;

    case AForm.Position of
    poScreenCenter, poDesktopCenter, poMainFormCenter, poOwnerFormCenter,
    poDesigned: //i think i really want everything else to also follow the nudging rules...why did i exclude poDesigned
        begin
            //This was only nudging by one quarter the difference, rather than one half the difference
//          x := RectAfter.Left - ((RectAfter.Right-RectBefore.Right) div 2);
//          y := RectAfter.Top - ((RectAfter.Bottom-RectBefore.Bottom) div 2);
            x := RectAfter.Left - ((RectAfter.Right-RectAfter.Left) - (RectBefore.Right-RectBefore.Left)) div 2;
            y := RectAfter.Top - ((RectAfter.Bottom-RectAfter.Top)-(RectBefore.Bottom-RectBefore.Top)) div 2;
        end;
    else
        //poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly:
        x := RectAfter.Left;
        y := RectAfter.Top;
    end;

    if AForm.Monitor <> nil then
    begin
        monitorInfo.cbSize := SizeOf(monitorInfo);
        if GetMonitorInfo(AForm.Monitor.Handle, @monitorInfo) then
            workArea := monitorInfo.rcWork
        else
        begin
            OutputDebugString(PChar(SysErrorMessage(GetLastError)));
            workArea := Rect(AForm.Monitor.Left, AForm.Monitor.Top, AForm.Monitor.Left+AForm.Monitor.Width, AForm.Monitor.Top+AForm.Monitor.Height);
        end;

//      If the form is off the right or bottom of the screen then we need to pull it back
        if RectAfter.Right > workArea.Right then
            x := workArea.Right - (RectAfter.Right-RectAfter.Left); //rightEdge - widthOfForm

        if RectAfter.Bottom > workArea.Bottom then
            y := workArea.Bottom - (RectAfter.Bottom-RectAfter.Top); //bottomEdge - heightOfForm

        x := Max(x, workArea.Left); //don't go beyond left edge
        y := Max(y, workArea.Top); //don't go above top edge
    end
    else
    begin
        x := Max(x, 0); //don't go beyond left edge
        y := Max(y, 0); //don't go above top edge
    end;

    AForm.SetBounds(x, y,
            RectAfter.Right-RectAfter.Left, //Width
            RectAfter.Bottom-RectAfter.Top); //Height
end;

然后我们必须递归地使用新字体：

procedure StandardizeFont_ControlCore(AControl: TControl; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    i: Integer;
    RunComponent: TComponent;
    AControlFont: TFont;
begin
    if not Assigned(AControl) then
        Exit;

    if (AControl is TStatusBar) then
    begin
        TStatusBar(AControl).UseSystemFont := False; //force...
        TStatusBar(AControl).UseSystemFont := True;  //...it
    end
    else
    begin
        AControlFont := Toolkit.GetControlFont(AControl);

        if not Assigned(AControlFont) then
            Exit;

        StandardizeFont_ControlFontCore(AControlFont, ForceClearType,
                FontName, FontSize,
                ForceFontIfName, ForceFontIfSize);
    end;

{   If a panel has a toolbar on it, the toolbar won't paint properly. So this idea won't work.
    if (not Toolkit.IsRemoteSession) and (AControl is TWinControl) and (not (AControl is TToolBar)) then
        TWinControl(AControl).DoubleBuffered := True;
}

    //Iterate children
    for i := 0 to AControl.ComponentCount-1 do
    begin
        RunComponent := AControl.Components[i];
        if RunComponent is TControl then
            StandardizeFont_ControlCore(
                    TControl(RunComponent), ForceClearType,
                    FontName, FontSize,
                    ForceFontIfName, ForceFontIfSize);
    end;
end;

锚点被递归禁用：

function DisableAnchors(ParentControl: TWinControl): TAnchorsArray;
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    DisableAnchors_Core(ParentControl, Result, StartingIndex);
end;


procedure DisableAnchors_Core(ParentControl: TWinControl; var aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
    iCounter: integer;
    ChildControl: TControl;
begin
    if (StartingIndex+ParentControl.ControlCount+1) > (Length(aAnchorStorage)) then
        SetLength(aAnchorStorage, StartingIndex+ParentControl.ControlCount+1);

    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        aAnchorStorage[StartingIndex] := ChildControl.Anchors;

        //doesn't work for set of stacked top-aligned panels
//      if ([akRight, akBottom ] * ChildControl.Anchors) <> [] then
//          ChildControl.Anchors := [akLeft, akTop];

        if (ChildControl.Anchors) <> [akTop, akLeft] then
            ChildControl.Anchors := [akLeft, akTop];

//      if ([akTop, akBottom] * ChildControl.Anchors) = [akTop, akBottom] then
//          ChildControl.Anchors := ChildControl.Anchors - [akBottom];

        Inc(StartingIndex);
    end;

    //Add children
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        if ChildControl is TWinControl then
            DisableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
    end;
end;

并且递归地重新启用锚点：

procedure EnableAnchors(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray);
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    EnableAnchors_Core(ParentControl, aAnchorStorage, StartingIndex);
end;


procedure EnableAnchors_Core(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
    iCounter: integer;
    ChildControl: TControl;
begin
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        ChildControl.Anchors := aAnchorStorage[StartingIndex];

        Inc(StartingIndex);
    end;

    //Restore children
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        if ChildControl is TWinControl then
            EnableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
    end;
end;

将实际更改控件字体的工作留给：

procedure StandardizeFont_ControlFontCore(AControlFont: TFont; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    CanChangeName: Boolean;
    CanChangeSize: Boolean;
    lf: TLogFont;
begin
    if not Assigned(AControlFont) then
        Exit;

{$IFDEF ForceClearType}
    ForceClearType := True;
{$ELSE}
    if g_ForceClearType then
        ForceClearType := True;
{$ENDIF}

    //Standardize the font if it's currently
    //  "MS Shell Dlg 2" (meaning whoever it was opted into the 'change me' system
    //  "MS Sans Serif" (the Delphi default)
    //  "Tahoma" (when they wanted to match the OS, but "MS Shell Dlg 2" should have been used)
    //  "MS Shell Dlg" (the 9x name)
    CanChangeName :=
            (FontName <> '')
            and
            (AControlFont.Name <> FontName)
            and
            (
                (
                    (ForceFontIfName <> '')
                    and
                    (AControlFont.Name = ForceFontIfName)
                )
                or
                (
                    (ForceFontIfName = '')
                    and
                    (
                        (AControlFont.Name = 'MS Sans Serif') or
                        (AControlFont.Name = 'Tahoma') or
                        (AControlFont.Name = 'MS Shell Dlg 2') or
                        (AControlFont.Name = 'MS Shell Dlg')
                    )
                )
            );

    CanChangeSize :=
            (
                //there is a font size
                (FontSize <> 0)
                and
                (
                    //the font is at it's default size, or we're specifying what it's default size is
                    (AControlFont.Size = 8)
                    or
                    ((ForceFontIfSize <> 0) and (AControlFont.Size = ForceFontIfSize))
                )
                and
                //the font size (or height) is not equal
                (
                    //negative for height (px)
                    ((FontSize < 0) and (AControlFont.Height <> FontSize))
                    or
                    //positive for size (pt)
                    ((FontSize > 0) and (AControlFont.Size <> FontSize))
                )
                and
                //no point in using default font's size if they're not using the face
                (
                    (AControlFont.Name = FontName)
                    or
                    CanChangeName
                )
            );

    if CanChangeName or CanChangeSize or ForceClearType then
    begin
        if GetObject(AControlFont.Handle, SizeOf(TLogFont), @lf) <> 0 then
        begin
            //Change the font attributes and put it back
            if CanChangeName then
                StrPLCopy(Addr(lf.lfFaceName[0]), FontName, LF_FACESIZE);
            if CanChangeSize then
                lf.lfHeight := FontSize;

            if ForceClearType then
                lf.lfQuality := CLEARTYPE_QUALITY;
            AControlFont.Handle := CreateFontIndirect(lf);
        end
        else
        begin
            if CanChangeName then
                AControlFont.Name := FontName;
            if CanChangeSize then
            begin
                if FontSize > 0 then
                    AControlFont.Size := FontSize
                else if FontSize < 0 then
                    AControlFont.Height := FontSize;
            end;
        end;
    end;
end;

这比你想象的要多得多;我知道。令人遗憾的是，除了我之外，世界上没有Delphi开发人员，他们实际上使他们的应用程序正确。

  

亲爱的Delphi开发人员：将您的Windows字体设置为 Segoe UI 14pt ，并修复您的错误应用程序

     

注意：任何代码都会发布到公共域中。无需归属。

Answer 4

这是我的礼物。一个可以帮助您在GUI布局中水平定位元素的函数。所有人都免费。

function CenterInParent(Place,NumberOfPlaces,ObjectWidth,ParentWidth,CropPercent: Integer): Integer;
  {returns formated centered position of an object relative to parent.
  Place          - P order number of an object beeing centered
  NumberOfPlaces - NOP total number of places available for object beeing centered
  ObjectWidth    - OW width of an object beeing centered
  ParentWidth    - PW width of an parent
  CropPercent    - CP percentage of safe margin on both sides which we want to omit from calculation
  +-----------------------------------------------------+
  |                                                     |
  |        +--------+       +---+      +--------+       |
  |        |        |       |   |      |        |       |
  |        +--------+       +---+      +--------+       |
  |     |              |             |            |     |
  +-----------------------------------------------------+
  |     |<---------------------A----------------->|     |
  |<-C->|<------B----->|<-----B----->|<-----B---->|<-C->|
  |                    |<-D>|
  |<----------E------------>|

  A = PW-C   B = A/NOP  C=(CP*PW)/100  D = (B-OW)/2
  E = C+(P-1)*B+D }

var
  A, B, C, D: Integer;
begin
  C := Trunc((CropPercent*ParentWidth)/100);
  A := ParentWidth - C;
  B := Trunc(A/NumberOfPlaces);
  D := Trunc((B-ObjectWidth)/2);
  Result := C+(Place-1)*B+D;
end;