如何让Delphi TWebBrowser组件适配显示器DPI缩放？

问题描述 #

使用Delphi 11编写程序，测试StackOverflow上Martin Schneider提供的两种TWebBrowser高DPI支持方案后，将程序拖到175%缩放比例的显示器时，仅程序标题栏适配了缩放，TWebBrowser组件内的页面内容未缩放。

已尝试的操作：

• 实现Martin的“方案2”：自定义TDpiAwareWebBrowser类并添加DOCHOSTUIFLAG_DPI_AWARE标志，代码如下：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.IOUtils,
  Vcl.StdCtrls, Vcl.ExtCtrls, ShellAPI, Vcl.ComCtrls, Vcl.ToolWin, System.StrUtils,
  ShlObj, System.UITypes, Vcl.OleCtrls, SHDocVw,
  Winapi.Mshtmhst;

type
  TDpiAwareWebBrowser = class(TWebBrowser, IDocHostUIHandler)
    strict private
      // IDocHostUIHandler "override"
      function GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; stdcall;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

const
  DOCHOSTUIFLAG_DPI_AWARE = $40000000;

function TDpiAwareWebBrowser.GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT;
begin
  // original code from TWebBrowser.GetHostInfo
  pInfo.cbSize := SizeOf(pInfo);
  pInfo.dwFlags := 0;
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_NO3DBORDER;
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_THEME;
  pInfo.dwFlags := pInfo.dwFlags or DOCHOSTUIFLAG_DPI_AWARE; // NEW added flag
  Result := S_OK;
  //ResizeScrollBars; // will be called by subsequent routines anyway.
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  var wb:= TDpiAwareWebBrowser.Create(Form1);
  TWinControl(wb).Parent:= Form1;
  wb.align:= alClient;
  wb.Navigate('https://google.com');
end;

end.

• 尝试Martin的“方案1”：修改注册表FEATURE_960DPI_PIXEL项
• 调整注册表FEATURE_BROWSER_EMULATION项
• 添加页面Meta标签进行浏览器模拟

开发环境：Delphi 11、Windows 10系统、VMware Workstation 16 Pro虚拟机

排查与解决要点 #

1. 确认程序DPI感知模式配置 #

Delphi 11默认的DPI感知设置需确保正确，检查项目配置：

• 打开项目选项 → Application → Manifest，确认DPI Awareness设置为Per Monitor V2或High DPI Aware
• 若手动修改manifest文件，需确保包含以下配置节点：

<application xmlns="urn:schemas-microsoft-com:asm.v3">
  <windowsSettings>
    <dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true/PM</dpiAware>
    <dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2, PerMonitor</dpiAwareness>
  </windowsSettings>
</application>

2. 补全IDocHostUIHandler接口完整实现 #

自定义TDpiAwareWebBrowser类仅实现GetHostInfo会导致COM调度失败，需补全接口所有方法（大部分返回E_NOTIMPL即可）：

type
  TDpiAwareWebBrowser = class(TWebBrowser, IDocHostUIHandler)
  strict private
    // IDocHostUIHandler 完整方法声明
    function GetHostInfo(var pInfo: TDocHostUIInfo): HRESULT; stdcall;
    function ShowContextMenu(const dwID: DWORD; const ppt: PPoint;
      const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT; stdcall;
    function ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
      const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
      const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall;
    function HideUI: HRESULT; stdcall;
    function UpdateUI: HRESULT; stdcall;
    function EnableModeless(const fEnable: BOOL): HRESULT; stdcall;
    function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall;
    function ResizeBorder(const prcBorder: PRect; const pUIWindow: IOleInPlaceUIWindow;
      const fFrameWindow: BOOL): HRESULT; stdcall;
    function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID;
      const nCmdID: DWORD): HRESULT; stdcall;
    function GetOptionKeyPath(var pchKey: POLESTR; const dw: DWORD): HRESULT; stdcall;
    function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall;
    function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall;
    function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POLESTR;
      out ppchURLOut: POLESTR): HRESULT; stdcall;
    function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall;
  end;

// 补全方法实现，除GetHostInfo外其余返回E_NOTIMPL
function TDpiAwareWebBrowser.ShowContextMenu(const dwID: DWORD; const ppt: PPoint;
  const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
begin
  Result := E_NOTIMPL;
end;

function TDpiAwareWebBrowser.ShowUI(const dwID: DWORD; const pActiveObject: IOleInPlaceActiveObject;
  const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame;
  const pDoc: IOleInPlaceUIWindow): HRESULT;
begin
  Result := E_NOTIMPL;
end;

// 其余方法同理，全部实现并返回E_NOTIMPL

3. 验证注册表项的正确配置 #

• FEATURE_960DPI_PIXEL：在HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_960DPI_PIXEL路径下，添加你的程序.exe名称（如MyApp.exe），值设为1（DWORD类型）
• FEATURE_BROWSER_EMULATION：在HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION路径下，添加程序.exe名称，值设为与系统兼容的版本（Windows 10推荐11001，对应IE11 Edge模式）

4. 排查虚拟机DPI传递问题 #

VMware虚拟机可能存在DPI传递异常，尝试：

• 关闭虚拟机的自动调整客户机显示大小功能，手动设置分辨率后再测试
• 更新VMware Tools到最新版本，确保DPI感知功能正常传递到客户机系统

5. 确保页面viewport Meta标签配置 #

在加载的页面中添加正确的viewport标签，强制页面适配高DPI：

<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=no">

内容的提问来源于stack exchange，提问作者CaptureWiz