从 Delphi VCL 应用程序可靠地读取 Windows 缩放因子

Question

为了在我的应用程序中正确处理 DPI 更改，我使用以下代码读取当前的缩放因子：

TYPE TZoom = BYTE;

FUNCTION OldStyleGetDpiForSystem : TZoom; cdecl;
  VAR
    DC          : HDC;
    X,Y,Z       : LongWord;

  BEGIN
    DC:=GetDC(0);
    TRY
      X:=GetDeviceCaps(DC,LOGPIXELSX);
      Y:=GetDeviceCaps(DC,LOGPIXELSY)
    FINALLY
      ReleaseDC(0,DC)
    END;
    IF X>Y THEN Result:=X ELSE Result:=Y
  END;

FUNCTION GetDpiForSystem : TZoom;
  TYPE
    GetDpiForSystemFunc = FUNCTION : TZoom; cdecl;

  CONST
    GetDpiForSystem     : GetDpiForSystemFunc = NIL;

  BEGIN
    IF NOT Assigned(GetDpiForSystem) THEN BEGIN
      // Try to use official method (available from Windows 10, version 1607 [desktop apps only] and on)
      GetDpiForSystem:=GetProcAddress(LoadLibrary('USER32.DLL'),'GetDpiForSystem');
      // If not found, then use fall-back method with GetDeviceCaps of DeskTop
      IF NOT Assigned(GetDpiForSystem) THEN GetDpiForSystem:=OldStyleGetDpiForSystem
      // In any case, only determine method once, but call the method every time, as the DPI can change
      // while the application is running
    END;
    Result:=ROUND(GetDpiForSystem/USER_DEFAULT_SCREEN_DPI*100.0)
  END;

FUNCTION WindowsScaleFactor : TZoom;
  BEGIN
    Result:=GetDpiForSystem
  END;

我的问题是，无论我在 Windows (Windows 10) 中设置了什么设置，它总是返回 100 (96 dpi)。

我已经使用默认项目设置编译了我的应用程序（即清单文件自动生成，标签包括：启用运行时主题和启用高 DPI）。

我也试过关闭“启用高 DPI”，然后在应用程序中手动启用它（但我在尝试时遇到错误，这表明 DPI 模式已经设置，但这可能是另一个问题了）。

任何人都可以指导我朝着一个方向可靠地读取Windows 中设置的当前DPI 比例因子吗？我还需要响应 DPI 更改，但似乎无法拦截 WM_DPICHANGED 消息。我应该在哪里截取这条消息？在应用程序级别还是在表单级别？

要重现我的测试设置，请创建一个空的 VCL 应用程序，上面有一个名为 Button1 的按钮。在 FormCreate 事件中，放入以下代码：

procedure TForm14.FormCreate(Sender: TObject);
begin
  Button1.Caption:=IntToStr(WindowsScaleFactor)
end;

将 Button1.OnClick 事件附加到 FormCreate 方法，以便按钮标题在启动时初始化，并在每次单击时刷新。

然后运行应用程序。按钮标题应以 100 开头（如果您以 100% 缩放运行）。然后尝试在 Windows 中更改缩放比例并单击按钮。它应该更改为您选择的值，但是（在我的 PC 上）它仍然返回 100%。

清单（从编译的 .EXE 中提取）如下：

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
  <asmv3:application>
    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>True/PM</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
  <dependency>
    <dependentAssembly>
      <assemblyIdentity
        type="win32"
        name="Microsoft.Windows.Common-Controls"
        version="6.0.0.0"
        publicKeyToken="6595b64144ccf1df"
        language="*"
        processorArchitecture="*"/>
    </dependentAssembly>
  </dependency>
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel
          level="asInvoker"
          uiAccess="false"
        />
        </requestedPrivileges>
    </security>
  </trustInfo>
<compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
        <application>
                <!--The ID below indicates app support for Windows Vista -->
                <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
                <!--The ID below indicates app support for Windows 7 -->
                <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
                <!--The ID below indicates app support for Windows 8 -->
                <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
                <!--The ID below indicates app support for Windows 8.1 -->
                <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
                <!--The ID below indicates app support for Windows 10 -->
                <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
        </application>
</compatibility>
</assembly>

Answer 1

我建议您首先阅读这篇博文

vcl 应用程序中的 dpi 感知

您可以通过为 TForm.OnBeforeMonitorDPIChanged 和 TForm.OnAfterMonitorDPIChanged 设置事件处理程序来响应 dpi 更改

procedure FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);
procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer);

事件参数将告诉您新的 DPI 和旧的 DPI。

您的清单设置正确。