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

Question

提问by LaBracca

When choosing large font sizes in the Windows control panel (like 125%, or 150%) then there are problems in a VCL application, every time something has been set pixelwise.

当在 Windows 控制面板中选择大字体大小（如 125% 或 150%）时，VCL 应用程序就会出现问题，每次设置像素级时都会出现问题。

Take the TStatusBar.Panel. I have set its width so that it contains exactly one label, now with big fonts the label "overflows". Same problem with other components.

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

Some new laptops from Dell ship already with 125% as default setting, so while in the past this problem was quite rare now it is really important.

戴尔的一些新笔记本电脑已经将 125% 作为默认设置，因此虽然过去这个问题很少见，但现在非常重要。

What can be done to overcome this problem?

可以做些什么来克服这个问题？

Answer 1

采纳答案by Warren P

Note: Please see the other answers as they contain very valuable techniques. My answer here only provides caveats and cautions against assuming DPI-awareness is easy.

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

I generally avoid DPI-aware scaling with TForm.Scaled = True. DPI awareness is only important to me when it becomes important to customers who call me and are willing to pay for it. The technical reason behind that point of view is that DPI-awareness or not, you are opening a window into a world of hurt. Many standard and third party VCL controls do not work well in High DPI. The notable exception that the VCL parts that wrap Windows Common Controls work remarkably well at high DPI. A huge number of third party and built-in Delphi VCL custom controls do not work well, or at all, at high DPI. If you plan to turn on TForm.Scaled be sure to test at 96, 125, and 150 DPI for every single form in your project, and every single third party and built in control that you use.

我通常避免使用TForm.Scaled = True. 只有当 DPI 意识对打电话给我并愿意为此付费的客户变得重要时，它才对我很重要。这种观点背后的技术原因是 DPI 意识与否，你正在打开一扇通往伤害世界的窗口。许多标准和第三方 VCL 控件在高 DPI 中无法正常工作。一个显着的例外是包装 Windows 通用控件的 VCL 部件在高 DPI 下工作得非常好。大量第三方和内置 Delphi VCL 自定义控件在高 DPI 下无法正常工作，或者根本无法正常工作。如果您打算打开 TForm.Scaled，请务必在 96、125 和 150 DPI 下对项目中的每个表单以及您使用的每个第三方和内置控件进行测试。

Delphi itself is written in Delphi. It has the High DPI awareness flag turned on, for most forms, although even as recently as in Delphi XE2, the IDE authors themselves decided NOT to turn that High DPI Awareness manifest flag on. Note that in Delphi XE4 and later, the HIGH DPI awareness flag is turned on, and the IDE looks good.

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

I suggest that you do not use TForm.Scaled=true (which is a default in Delphi so unless you've modified it, most of your forms have Scaled=true) with the High DPI Aware flags (as shown in David's answers) with VCL applications that are built using the built-in delphi form designer.

我建议您不要使用 TForm.Scaled=true （这是 Delphi 中的默认值，因此除非您修改它，否则您的大多数表单都具有 Scaled=true）与高 DPI 感知标志（如大卫的答案所示）使用内置的 delphi 表单设计器构建的 VCL 应用程序。

I have tried in the past to make a minimal sample of the kind of breakage you can expect to see when TForm.Scaled is true, and when Delphi form scaling has a glitch. These glitches are not always and only triggered by a DPI value other than 96. I have been unable to determine a complete list of other things, that includes Windows XP font size changes. But since most of these glitches appear only in my own applications, in fairly complex situations, I have decided to show you some evidence you can verify yourselves.

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

Delphi XE looks like this when you set the DPI Scaling to "Fonts @ 200%" in Windows 7, and Delphi XE2 is similarly broken on Windows 7 and 8, but these glitches appear to be fixed as of Delphi XE4:

在 Windows 7 中将 DPI Scaling 设置为“Fonts @ 200%”时，Delphi XE 看起来像这样，并且 Delphi XE2 在 Windows 7 和 8 上同样被破坏，但这些故障似乎从 Delphi XE4 开始得到修复：

enter image description here

在此处输入图片说明

enter image description here

在此处输入图片说明

These are mostly Standard VCL controls that are misbehaving at high DPI. Note that most things have not been scaled at all, so the Delphi IDE developers have decided to ignore the DPI awareness, as well as turning off the DPI virtualization. Such an interesting choice.

这些大多是在高 DPI 下行为不端的标准 VCL 控件。请注意，大多数事情根本没有进行缩放，因此 Delphi IDE 开发人员决定忽略 DPI 感知，并关闭 DPI 虚拟化。这么有趣的选择。

Turn off DPI virtualization only if want this new additional source of pain, and difficult choices. I suggest you leave it alone. Note that Windows common controls mostly seem to work fine. Note that the Delphi data-explorer control is a C# WinForms wrapper around a standard Windows Tree common control. That's a pure microsoft glitch, and fixing it might either require Embarcadero to rewrite a pure native .Net tree control for their data explorer, or to write some DPI-check-and-modify-properties code to change item heights in the control. Not even microsoft WinForms can handle high DPI cleanly, automatically and without custom kludge code.

仅当想要这种新的痛苦和困难选择的新来源时才关闭 DPI 虚拟化。我建议你别管它。请注意，Windows 通用控件似乎大多工作正常。请注意，Delphi 数据浏览器控件是围绕标准 Windows 树公共控件的 C# WinForms 包装器。这是一个纯粹的微软故障，修复它可能需要 Embarcadero 为他们的数据浏览器重写一个纯原生的 .Net 树控件，或者编写一些 DPI-check-and-modify-properties 代码来更改控件中的项目高度。甚至 microsoft WinForms 也无法干净、自动地处理高 DPI，并且无需自定义的杂乱代码。

Update: Interesting factoid: While the delphi IDE appears not to be "virtualized", it is not using the manifest content shown by David to achieve "non-DPI-virtualization". Perhaps it is using some API function at runtime.

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

Update 2: In response to how I would support 100%/125% DPI, I would come up with a two-phase plan. Phase 1 is to inventory my code for custom controls that need to be fixed for high DPI, and then make a plan to fix them or phase them out. Phase 2 would be to take some areas of my code which are designed as forms without layout management and change them over to forms that use some kind of layout management so that DPI or font height changes can work without clipping. I suspect that this "inter-control" layout work would be far more complex in most applications than the "intra-control" work.

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

Update:In 2016, the latest Delphi 10.1 Berlin is working well on my 150 dpi workstation.

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

Answer 2

回答by David Heffernan

Your settings in the .dfm file will be scaled up correctly, so long as Scaledis True.

您在 .dfm 文件中的设置将被正确放大，只要Scaled是True.

If you are setting dimensions in code then you need to scale them by Screen.PixelsPerInchdivided by Form.PixelsPerInch. Use MulDivto do this.

如果您在代码中设置尺寸，则需要按Screen.PixelsPerInch除以来缩放它们Form.PixelsPerInch。使用MulDiv要做到这一点。

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

This is what the form persistence framework does when Scaledis True.

这就是表单持久化框架在Scaledis时所做的True。

In fact, you can make a cogent argument for replacing this function with a version that hard codes a value of 96 for the denominator. This allows you to use absolute dimension values and not worry about the meaning changing if you happen to change font scaling on your development machine and re-save the .dfm file. The reason that matters is that the PixelsPerInchproperty stored in the .dfm file is the value of the machine on which the .dfm file was last saved.

事实上，您可以提出一个有说服力的论据，用一个硬编码分母值为 96 的版本来替换这个函数。这允许您使用绝对尺寸值，而不必担心如果您碰巧在开发机器上更改字体缩放并重新保存 .dfm 文件，含义会发生变化。重要的原因是PixelsPerInch存储在 .dfm 文件中的属性是上次保存 .dfm 文件的机器的值。

const
  SmallFontsPixelsPerInch = 96;

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

So, continuing the theme, another thing to be wary of is that if your project is developed on multiple machines with different DPI values, you will find that the scaling that Delphi uses when saving .dfm files results in controls wandering over a series of edits. At my place of work, to avoid this, we have a strict policy that forms are only ever edited at 96dpi (100% scaling).

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

In fact my version of ScaleFromSmallFontsDimensionalso makes allowance for the possibility of the form font differing at runtime from that set at designtime. On XP machines my application's forms use 8pt Tahoma. On Vista and up 9pt Segoe UI is used. This provides yet another degree of freedom. The scaling must account for this because the absolute dimension values used in the source code are assumed to be relative to the baseline of 8pt Tahoma at 96dpi.

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

If you use any images or glyphs in your UI then these need to scale too. A common example would be the glyphs that are used on toolbars and menus. You'll want to provide these glyphs as icon resources linked to your executable. Each icon should contain a range of sizes and then at runtime you choose the most appropriate size and load it into an image list. Some details on that topic can be found here: How do I load icons from a resource without suffering from aliasing?

如果您在 UI 中使用任何图像或字形，那么它们也需要缩放。一个常见的例子是工具栏和菜单上使用的字形。您需要将这些字形作为链接到可执行文件的图标资源提供。每个图标应包含一系列大小，然后在运行时选择最合适的大小并将其加载到图像列表中。可以在此处找到有关该主题的一些详细信息：如何从资源加载图标而不会出现别名问题？

Another useful trick is to define dimensions in relative units, relative to TextWidthor TextHeight. So, if you want something to be around 10 vertical lines in size you can use 10*Canvas.TextHeight('Ag'). This is a very rough and ready metric because it doesn't allow for line spacing and so on. However, often all you need to do is be able to arrange that the GUI scales correctly with PixelsPerInch.

另一个有用的技巧是以相对单位定义尺寸，相对于TextWidth或TextHeight。所以，如果你想要一些东西的大小约为 10 条垂直线，你可以使用10*Canvas.TextHeight('Ag'). 这是一个非常粗略和现成的指标，因为它不允许行间距等。但是，通常您需要做的就是能够安排 GUI 使用 PixelsPerInch.

You should also mark your application as being high DPI aware. The best way to do this is through the application manifest. Since Delphi's build tools don't allow you to customise the manifest you use this forces you to link your own manifest resource.

您还应该将您的应用程序标记为高 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>

The resource script looks like this:

资源脚本如下所示：

1 24 "Manifest.txt"

where Manifest.txtcontains the actual manifest. You would also need to include the comctl32 v6 section and set requestedExecutionLevelto asInvoker. You then link this compiled resource to your app and make sure that Delphi doesn't try to do the same with its manifest. In modern Delphi you achieve that by setting the Runtime Themes project option to None.

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

The manifest is the rightway to declare your app to be high DPI aware. If you just want to try it out quickly without messing with your manifest, call SetProcessDPIAware. Do so as the very first thing you do when your app runs. Preferably in one of the early unit initialization sections, or as the first thing in your .dpr file.

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

If you don't declare your app to be high DPI aware then Vista and up will render it in a legacy mode for any font scaling above 125%. This looks quite dreadful. Try to avoid falling into that trap.

如果您不声明您的应用程序具有高 DPI 感知，那么 Vista 及更高版本将在任何字体缩放比例超过 125% 时以旧模式呈现它。这看起来非常可怕。尽量避免掉入那个陷阱。

Windows 8.1 per monitor DPI update

每台显示器的 Windows 8.1 DPI 更新

As of Windows 8.1, there is now OS support for per-monitor DPI settings (http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx). This is a big issue for modern devices which might have different displays attached with very different capabilities. You might have a very high DPI laptop screen, and a low DPI external projector. Supporting such a scenario takes even more work than described above.

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

Answer 3

回答by Ian Boyd

It's also important to note that honoring the user's DPI is only a subset of your real job:

同样重要的是要注意尊重用户的 DPI 只是您实际工作的一个子集：

honoring the user's font size

尊重用户的字体大小

For decades, Windows has solved this issue with the notion performing layout using Dialog Units, rather than pixels. A "dialog unit"is defined so that font's average characteris

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

4 dialog units (dlus) wide, and
8 dialog units (clus) high

4 个对话单元 (dlus) 宽，以及
8 个对话单元（簇）高

enter image description here

在此处输入图片说明

Delphi does ship with a (buggy) notion of Scaled, where a form tries to automatically adjust based on the

Delphi 确实附带了一个（错误的）概念Scaled，其中表单尝试根据

Windows DPI settings of the user, verses
the DPI setting on the machine of the developer who last saved the form

用户的 Windows DPI 设置，诗句
上次保存表单的开发人员机器上的 DPI 设置

That doesn't solve the problem when the user uses a font different from what you designed the form with, e.g.:

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

developer designed the form with MS Sans Serif 8pt(where the average character is 6.21px x 13.00px, at 96dpi)
user running with Tahoma 8pt(where the average character is 5.94px x 13.00px, at 96dpi)
As was the case with anyone developing an application for Windows 2000 or Windows XP.

开发人员使用MS Sans Serif 8pt（平均字符为6.21px x 13.00px96dpi）设计了表单
使用Tahoma 8pt运行的用户（平均字符为5.94px x 13.00px96dpi）
与为 Windows 2000 或 Windows XP 开发应用程序的任何人一样。

or

或者

developer designed the form with **Tahoma 8pt* (where the average character is 5.94px x 13.00px, at 96dpi)
a user running with Segoe UI 9pt(where the average character is 6.67px x 15px, at 96dpi)

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

As a good developer you are going to honor your user's font preferences. This means that you also need to scale all controls on your form to match the new font size:

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

expand everything horizontally by 12.29% (6.67/5.94)
stretch everything vertically by 15.38% (15/13)

横向扩展 12.29% (6.67/5.94)
将所有东西垂直拉伸 15.38% (15/13)

Scaledwon't handle this for you.

Scaled不会为你处理这个。

It gets worse when:

在以下情况下会变得更糟：

designed your form at Segoe UI 9pt(the Windows Vista, Windows 7, Windows 8 default)
user is running Segoe UI 14pt, (e.g. my preference) which is 10.52px x 25px

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

Now you have to scale everything

现在你必须扩展一切

horizontally by 57.72%
vertically by 66.66%

横向 57.72%
纵向 66.66%

Scaledwon't handle this for you.

Scaled不会为你处理这个。

If you're smart you can see how honoring DPI is irrelavent:

如果你很聪明，你会看到尊重 DPI 是多么无关紧要：

form designed with Segoe UI 9pt @ 96dpi (6.67px x 15px)
user running with Segoe UI 9pt @ 150dpi (10.52px x 25px)

使用 Segoe UI 9pt @ 96dpi (6.67px x 15px) 设计的表单
使用 Segoe UI 9pt @ 150dpi (10.52px x 25px) 运行的用户

You should not be looking at the user's DPI setting, you should be looking at their font size. Two users running

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

Segoe UI 14pt @ 96dpi (10.52px x 25px)
Segoe UI 9pt @ 150dpi (10.52px x 25px)

Segoe UI 14pt @ 96dpi (10.52px x 25px)
Segoe UI 9pt @ 150dpi (10.52px x 25px)

are running the same font. DPI is just onething that affects font size; the user's preferences are the other.

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

StandardizeFormFont

标准化字体

Clovis noticed that i reference a function StandardizeFormFontthat fixes the font on a form, and scales it to the new font size. It's not a standard function, but an entire set of functions that accomplish the simple task that Borland never handled.

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 has 6 different fonts; there is no single "font setting" in Windows.
But we know from experience that our forms should follow the Icon Title Fontsetting

Windows 有 6 种不同的字体；Windows 中没有单一的“字体设置”。
但是我们从经验中知道我们的表单应该遵循Icon Title Font设置

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;

Once we know the font size we will scale the form to, we get the form's current font height (in pixels), and scale up by that factor.

一旦我们知道字体大小，我们将把表单缩放到，我们就得到了表单的当前字体高度（以像素为单位），并按该因子进行缩放。

For example, if i am setting the form to -16, and the form is currently at -11, then we need to scale the entire form by:

例如，如果我将表单设置为-16，并且表单当前位于-11，那么我们需要通过以下方式缩放整个表单：

-16 / -11 = 1.45454%

The standardization happens in two phases. First scale the form by the ratio of the new:old font sizes. Then actually change the controls (recursively) to use the new font.

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

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;

Here's the job of actually scaling a form. It works around bugs in Borland's own Form.ScaleBymethod. First it has to disable all anchors on the form, then perform the scaling, then re-enable the anchors:

这是实际缩放表单的工作。它可以解决 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;

and then we have to recursively actually usethe new font:

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

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;

With the anchors being recursively disabled:

随着锚被递归禁用：

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;

And anchors being recursively re-enabled:

并且以递归方式重新启用锚点：

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;

With the work of actually changing a controls font left to:

随着实际将控件字体更改为：

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;

That's a whole lot more code than you thought it was going to be; i know. The sad thing is that there is no Delphi developer on earth, except for me, who actually makes their applications correct.

这比你想象的要多得多；我知道。可悲的是，地球上没有 Delphi 开发人员，除了我，他实际上使他们的应用程序正确。

Dear Delphi Developer: Set your Windows font to Segoe UI 14pt, and fix your buggy application
Note: Any code is released into the public domain. No attribution required.

亲爱的 Delphi 开发人员：将您的 Windows 字体设置为Segoe UI 14pt，并修复您的错误应用程序
注意：任何代码都发布到公共领域。不需要归属。

Answer 4

回答by avra

Here is my gift. A function that can help you with horizontal positioning of elements in your GUI layouts. Free for all.

这是我的礼物。可以帮助您在 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;

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

提问by LaBracca

采纳答案by Warren P

回答by David Heffernan

回答by Ian Boyd

StandardizeFormFont

标准化字体

回答by avra

相关推荐

最近更新

标签

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

提问by LaBracca

采纳答案by Warren P

回答by David Heffernan

回答by Ian Boyd

StandardizeFormFont

标准化字体

回答by avra

相关推荐

如何在 Windows 中将文件上传到 Solr？

你如何在 Octave 中获得你的路径（在 Windows 上）？

windows 将 .txt 上传到 FTP 的批处理文件

为什么 Windows 上的 git diff 警告“终端功能不全”？

相关推荐

最近更新

标签