如何解决高 DPI 问题？答案

【问题标题】：How to work arround the high DPI issue?如何解决高 DPI 问题？
【发布时间】：2015-10-28 17:20:52
【问题描述】：

我需要从 Delphi 程序中获取桌面分辨率。
但是，如果程序不支持 DPI，Windows 会谎报真实的屏幕分辨率，所以各种问题都会从这里出现。

由于要让程序完全识别 DPI 的工作量太大（并且我尝试避免使用 WMI solution），我正在考虑使用一个快速的肮脏技巧：我将创建一个可识别 DPI 的微观控制台程序，该程序将读取真正的分辨率。

每次需要分辨率时，主程序都会使用启动这个小程序（隐藏）。看起来很简单。对吧？

问题 1：我还有其他（更好的）选择吗？
问题 2：我试图创建那个小程序。虽然它有大约 10 行代码，但它的 EXE 大小为 2.1MB，内存占用为 5.4MB！我可以把它变小吗？如果程序足够小（小于 1MB RAM），我可以让它一直运行而不会惹恼用户。

【问题讨论】：

一个解决方案是 WMI，但 WMI 不是所有 Windows 计算机都可用。
我也是这么读的，包括提到写一个小实用程序。对不起，如果你没有把区别说清楚。这不是欺凌，也不是废话。是用户写了非常相似的问题，却没有明确说明为什么它们不同。如果您没有尽职尽责地说明差异，请不要怪我。
我不知道你为什么在这里坚持粗鲁和咄咄逼人。首先，您无权告诉任何人远离 - 当您在此处发帖时，每个人都可以回答、编辑或投票结束。不喜欢？不要发帖。其次，我并不粗鲁。您发布了似乎是重复的问题，我就这样关闭了它；它已重新开放。别发牢骚了。第三，正如您在我的个人资料中看到的那样，我在这里提供了数千个不错的答案。如果您不想结束您的问题，请写出更好的问题。如果您不想编辑它们，请写出更好的问题。

标签： delphi delphi-xe7

【解决方案1】：

问题 1：我还有其他（更好的）选择吗？

您可以按照之前的问题使用 WMI：How to obtain the real screen resolution in a High DPI system?

问题 2：我尝试创建那个小程序。虽然它有大约 10 行代码，但它的 EXE 大小为 2.1MB，内存占用为 5.4MB！我可以把它变小吗？

诀窍是避免使用任何 VCL 单元，并尽量减少您使用的 RTL 单元的数量。您的目标应该是仅使用 Windows 单位。甚至可以避免它并为您需要的功能创建自己的 Windows API 导入。

另一种选择是使用不同的编程语言创建这个程序，这种语言能够更好地删除死代码。我可能会用一个简短的 C 程序来做到这一点。

【讨论】：

谢谢大卫 - 我知道你以前的答案 - 与 wmi 相关的答案。但如果可能的话，我会尽量避免使用 WMI。很大一部分 Windows 计算机无法正常运行 WMI 或根本没有 WMI。第二个问题是跨平台兼容性。我现在正在权衡两种可能性（WMI 与外部“DOS”帮助应用程序）
这里没有 DOS。控制台应用程序是 Windows 程序而不是 DOS 程序。不必是控制台应用程序。可以是不显示 GUI 的 GUI 应用程序。毕竟，为什么要做一个你不需要的控制台。跨平台无关紧要，因为 DPI 意识是 Windows 特有的。我个人从来没有遇到过没有 WMI 的机器，但显然你知道你的目标机器。
我知道。这是个笑话。这就是我将“DOS”放在引号中的原因。我为我的误会道歉。控制台程序看起来非常像 DOS 程序，你几乎不能称之为（在他们可爱的“控制台”中）。
看来WMI服务默认是禁用的：youtube.com/watch?v=JgsHfc-4TUE

【解决方案2】：

这是 30KB 和一个普通的图标，如果你 UPX 它是 15KB，用 Delphi 10 Seattle 编译，在我的系统中大约需要 150-200 毫秒。

program ScreenSupport;

{$APPTYPE CONSOLE}

{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}

uses
  Windows,
  Messages;

{$R *.res}

{$SetPEFlags $0200} // IMAGE_FILE_DEBUG_STRIPPED}      // $0200
{$SetPEFlags $0004} // IMAGE_FILE_LINE_NUMS_STRIPPED}  // $0004
{$SetPEFlags $0008} // IMAGE_FILE_LOCAL_SYMS_STRIPPED} // $0008
{$SetPEFlags $0001} // IMAGE_FILE_RELOCS_STRIPPED}     // $0001

Const WM_APP = $8000;
      msgSendScreenres = WM_APP+1;
      SM_CXVIRTUALSCREEN = 78;
      SM_CYVIRTUALSCREEN = 79;

function GetDesktopHeight: Integer;
begin
  Result := GetSystemMetrics(SM_CYVIRTUALSCREEN);
end;

function GetDesktopWidth: Integer;
begin
  Result := GetSystemMetrics(SM_CXVIRTUALSCREEN);
end;

procedure SendScreenRes(t: THandle);
begin
  if t = 0 then Exit;
  PostMessage(t,msgSendScreenres,GetDesktopWidth,GetDesktopHeight);
end;

function IsAnyParam(s: string): Boolean;
Var a: Integer;
begin
  Result := False;
  if ParamCount = 0 then Exit;
  for a := 1 to ParamCount do
   if ParamStr(a) = s then Exit(True);
end;

function StrToInt(const S: string): Integer;
Var E: Integer;
begin
  Val(S, Result, E);
end;

begin
// screen res requested
  if IsAnyParam('-screenres') then begin
    try
      SendScreenRes(StrToInt(ParamStr(2)));
    except
      Exit;
    end;
  end;
end.

要使用它，请从您的主应用程序中调用它：

Const msgSendScreenres = WM_APP+1;

ShellExecute(0,'open','ScreenSupport.exe',PChar('-screenres '+IntToStr(Form1.Handle)),'',SW_HIDE);

然后将其添加到主单元上的私有声明中

procedure WMScreenRes(var Msg: TMessage); message msgSendScreenres;

然后抓住它

procedure TForm1.WMScreenRes(var Msg: TMessage);
begin
  ScreenWidth  := Msg.WParam;
  ScreenHeight := Msg.LParam;
end;

【讨论】：