logo标签列表

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

windowsdelphiwindows-7
111

在Windows控制面板中选择大字号（如125%或150%）时，VCL应用程序存在问题，每次设置像素精细度时都会出现问题。

以 TStatusBar.Panel 为例。我已经设置了它的宽度，使其恰好包含一个标签，但是使用大字体时，标签会“溢出”。其他组件也存在相同的问题。

戴尔的一些新款笔记本电脑已将125%设置为默认值，因此尽管过去这个问题非常罕见，现在变得非常重要。

如何解决这个问题？

嗨。现在 Windows 和 Delphi 都更好地支持 HiDPI，你有什么建议/更新/见解吗？ - Gabriel
4个回答
65

只要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中使用任何图像或图标，则这些内容也需要进行缩放。常见的示例是工具栏和菜单上使用的图标。您将希望将这些图标作为链接到可执行文件的图标资源提供。每个图标都应包含一系列尺寸，然后在运行时选择最合适的尺寸并将其加载到图像列表中。关于该主题的一些详细信息可以在此处找到：如何从资源加载图标而不会遭受走样？ 另一个有用的技巧是使用相对单位来定义尺寸，相对于TextWidth或TextHeight。因此，如果您想让某个东西的垂直大小大约为10行，则可以使用10*Canvas.TextHeight('Ag')。这是一种非常粗略和简单的度量方法，因为它不考虑行间距等因素。然而，通常您只需要能够安排GUI与PixelsPerInch正确缩放即可。
您还应将应用程序标记为高DPI感知。这样做的最佳方式是通过应用程序清单。由于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中，通过将运行时主题项目选项设置为None来实现。

清单是声明您的应用程序支持高DPI的正确方式。如果您只想快速尝试而不破坏清单，请调用SetProcessDPIAware。在应用程序运行时的第一件事情就这样做。最好在早期单元初始化部分之一或在.dpr文件的第一件事情。

如果您未声明应用程序支持高DPI，则Vista及更高版本将在任何字体缩放超过125％的情况下以传统模式呈现它。这看起来非常可怕。尽量避免陷入这种困境。

Windows 8.1每个监视器DPI更新

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

2
这并不总是正确的。实际上，将Scaled设置为true，然后再设置高DPI感知，在大多数Delphi应用程序中也可能会导致一些奇怪的故障。我花费了数百个小时来尝试使我的应用程序在高DPI下工作，并发现与其存在控件被裁剪、移动到屏幕外、各种控件上额外或缺少滚动条等问题，不如让它们看起来难看一些。 - Warren P
3
没问题，使用Delphi构建应用程序可以比Delphi IDE本身表现更好。 - David Heffernan
1
我在Delphi 5、6、7中看到过许多带有固定边框的对话框，并且设置为true时会失败。隐藏确定、取消按钮等。甚至在Delphi2006中，我认为也受到了这个问题的困扰。混合使用原生的Delphi组件和Windows组件也会产生奇怪的效果。我总是以125%的字体缩放开发GUI，并将缩放属性设置为false。 - LU RD
2
很棒的东西。非常棒的信息，点赞！我的意见（不要这样做）在需要知道如何做时变得次要... - Warren P
2
我认为目前（我使用的是10.1 Berlin Update 2版本），你需要使用"Monitor.PixelsPerInch"而不是"Screen.PixelsPerInch"来支持具有不同分辨率的多个屏幕的系统。 "Screen.ppi"将始终返回相同的值，无论程序在哪个监视器上运行。 - Tony
显示剩余11条评论
58
注意：请参考其他答案，它们包含非常有价值的技术。我的答案只提供注意事项并警告不要轻易认为DPI感知很容易。
我通常不使用 TForm.Scaled = True 实现 DPI 感知缩放。对我而言，只有在顾客要求并愿意为此付费时，DPI 感知才变得重要。技术上讲，这样做的原因是，无论是否具备 DPI 感知，您都将打开一个充满风险的窗口。许多标准和第三方 VCL 控件在高 DPI 下表现不佳。需要特别指出的是，VCL 封装 Windows 常规控件的 VCL 部分在高 DPI 下表现良好。大量第三方和内置的 Delphi VCL 自定义控件在高 DPI 下表现不佳或根本不工作。如果您计划启用 TForm.Scaled，请确保针对项目中的每个窗体以及您使用的每个第三方和内置控件在 96、125 和 150 DPI 下进行测试。
Delphi 本身是用 Delphi 编写的。它已经为大多数窗体打开了高 DPI 感知标志，虽然即便是在 Delphi XE2 中，IDE 的作者们也决定不打开该高 DPI 感知清单标志。请注意，在 Delphi XE4 及更高版本中，已经打开了高 DPI 感知标志，IDE 看起来很好。
我建议您不要在使用内置的 delphi 窗体设计器构建的 VCL 应用程序中，将 TForm.Scaled=true（这是 Delphi 的默认设置，因此除非您已经修改过它，大多数窗体都具有 Scaled=true）与 DPI Aware 标志配合使用（如 David 的答案所示）。
我曾尝试过制作一个最小化的示例，以展示当 TForm.Scaled 为 true 且 Delphi 窗体缩放出现故障时，您可能会看到的破坏类型。这些故障并不总是和仅仅由 DPI 值不同触发。我无法确定其他因素的完整列表，包括 Windows XP 字体大小更改。但由于大多数这些故障仅在我的自己的应用程序中、在相当复杂的情况下出现，我已决定向您展示一些可供验证的证据。

当您在Windows 7中将DPI缩放设置为“字体@ 200％”时，Delphi XE看起来像这样，而Delphi XE2在Windows 7和8上也存在类似的问题，但是自Delphi XE4以来，这些故障似乎已经得到修复：

enter image description here

enter image description here

这些大多数是标准VCL控件，在高DPI下表现不佳。请注意，大多数东西都没有被缩放，因此Delphi IDE开发人员决定忽略DPI感知，以及关闭DPI虚拟化。这是一个有趣的选择。

只有想要新的痛苦和困难选择时才关闭DPI虚拟化。我建议您不要管它。请注意，Windows常用控件似乎大多正常工作。请注意，Delphi数据浏览器控件是一个C# WinForms包装器，围绕标准的Windows Tree常规控件。这是一个纯微软的故障，并且修复它可能需要Embarcadero重写一个纯本地的.Net树控件，或编写一些DPI检查和修改属性代码来更改控件中的项目高度。即使是Microsoft WinForms也无法自动，清晰地处理高DPI，而不需要自定义修补代码。

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

更新2：针对如何支持100%/125% DPI的问题，我的方案分为两个阶段。第一阶段是对自定义控件进行清单编制，确定需要修复或逐步淘汰的控件，并制定计划进行修复。第二阶段是将一些以表单形式设计但没有布局管理的代码转换成使用某种布局管理的表单，以便DPI或字体高度的变化可以避免裁剪。我怀疑，在大多数应用程序中，“控件间”布局工作要比“控件内”工作复杂得多。

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

5
那个API函数是SetProcessDPIAware。 - David Heffernan
2
太好了，感谢你提供这个新的信息点。我建议你修改你的答案，建议这是一种可能的路线。甚至可能有客户想要配置该选项（如果它对他们不起作用，则关闭它）。 - Warren P
6
RAD Studio是标准VCL控件、自定义控件、.NET WinForms和FireMonkey表单的大杂烩。因此出现问题也就不足为奇了。这也是为什么RAD Studio不是一个好的例子。 - Torbins
我不会说我为他们没有做到而辩护。我将他们直到最近仍然无法正确解决问题作为我的论点之一，即这比许多开发人员最初估计的要困难。如果你从未踩过这种龙粪堆，你可能会感觉比所有这些都好。我的观点是很多人在这里卡住了很长时间。请注意，我现在在批评微软，他们甚至不能让Sql Management Studio与DPI相适应，在SQL 2012中。 - Warren P
1
如果你是对的，那么问题可能出在VCL本身。即使是微软也有这个问题。我曾经使用过的唯一一个做得还算可以的框架是Mac上的COCOA。 - Warren P
显示剩余15条评论
42
重要的是要注意，尊重用户的DPI只是您真正工作的一部分:
尊重用户的字体大小
用户的DPI是其字体选择的副作用。
如果您尊重用户的字体大小，则您将根据定义尊重其DPI（好）。
如果您仅尊重用户的DPI，则不会尊重其字体选择（不好）。
Windows开发人员需要停止认为尊重DPI是他们想要做的事情。 您不想尊重他们的DPI。 DPI不是您想要尊重的设置。 如果您尊重DPI，则操作有误。
您想要尊重他们的字体。（这影响DPI）
几十年来，Windows一直通过使用“对话框单位”而不是像素来解决这个问题。一个“对话框单位”被定义为字体的“平均字符”的大小。
  • 4个对话框单位（dlus）宽
  • 8个对话框单位（dlus）高

enter image description here

Delphi自带一个(有缺陷的)概念TCustomForm.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 设计了表单（其中每个字符在96dpi下的平均大小为 5.94px x 13.00px）
  • 用户使用 Segoe UI 9pt 运行（其中每个字符在96dpi下的平均大小为 6.67px x 15px）

使用 TCustomForm.Scaled 是不好的。这是一个不好的想法，也是一个不好的选择和设计。你需要在设计时将所有表单的 .Scaled 设置为 False。

作为一名优秀的开发者，您的目标是尊重用户的字体偏好。这意味着您还需要缩放表单上的所有控件以匹配新的字体大小：
- 将所有内容水平扩展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只是影响字体大小的“一个”因素；用户的首选项是另一个因素。
标准化表单字体
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中没有单一的“字体设置”。Windows有6种不同的字体：
字体 如何检索
图标标题 SystemParametersInfo(SPI_GETICONTITLELOGFONT)
标题 SystemParametersInfo(SPI_GETNONCLIENTMETRICS).lfCaptionFont
小标题 SystemParametersInfo(SPI_GETNONCLIENTMETRICS).lfSmCaptionFont
菜单 SystemParametersInfo(SPI_GETNONCLIENTMETRICS).lfMenuFont
状态 SystemParametersInfo(SPI_GETNONCLIENTMETRICS).lfStatusFont
消息 SystemParametersInfo(SPI_GETNONCLIENTMETRICS).lfMessageFont

但是根据我们的经验，表单应该遵循图标标题字体设置。

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;

一旦我们知道了字体大小，我们将按比例缩放表单以适应它。我们获取表单当前的字体高度（以像素为单位），并按该因子放大。
例如，如果我将表单设置为-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，并修复您的有缺陷的应用程序。
注意：任何代码均发布到公共领域。不需要归属。
1
谢谢您的回答，但是在实际应用中您有什么建议吗？需要手动调整所有控件的大小吗？ - UnDiUdin
4
“可悲的是，除了我之外，地球上没有任何Delphi开发者能够正确制作他们的应用程序。” 这是一个非常傲慢且不正确的说法。在我的答案中，事实上我的“ScaleFromSmallFontsDimension”的版本也考虑到了设置在设计时与运行时不同的窗体字体的可能性。这种缩放必须加以考虑，因为源代码中使用的绝对尺寸值被假定相对于96dpi下8pt Tahoma的基线而言具有相对性。你的回答很好，点赞+1。 - David Heffernan
1
@Ian 不是我说的。听起来像是沃伦说的。 - David Heffernan
2
这非常棒，Ian。谢谢。 - Warren P
2
最近遇到了这个问题和答案。我已经将Ian的所有代码收集到一个工作单元中：http://pastebin.com/dKpfnXLc，并在Google+上发布了相关信息：https://goo.gl/0ARdq9。在这里发布，以防有人发现这很有用。 - W.Prins
显示剩余19条评论
11

这里是我的礼物。一个能够帮助你在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;
2
我很高兴你喜欢它，沃伦。这个程序大约有15年的历史了，当时还没有可用的解决方案来解决我所面临的问题。即使今天，也可能会出现适用的情况。B-) - avra
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接