在受 DPI 缩放影响的 Delphi VCL 应用程序中使用 Direct2D

Question

我正在研究在我的应用程序的某些部分用 Direct2D 替换 GDI。

为此，我阅读了官方的 Embarcadero documentation 并创建了这个最小的 Direct2D 应用程序：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Direct2D, D2D1;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FCanvas: TDirect2DCanvas;
  protected
    procedure CreateWnd; override;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    destructor Destroy; override;
    property Canvas: TDirect2DCanvas read FCanvas;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateWnd;
begin
  inherited;
  FreeAndNil(FCanvas);
  FCanvas := TDirect2DCanvas.Create(Handle);
end;

destructor TForm1.Destroy;
begin
  FreeAndNil(FCanvas);
  inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
  S: string;
begin
  Canvas.RenderTarget.Clear(D2D1ColorF(clWhite));
  R := ClientRect;
  S := 'Hello, Direct2D!';
  Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfCenter]);
  Canvas.MoveTo(0, 0);
  Canvas.LineTo(ClientWidth, ClientHeight);
  Canvas.MoveTo(0, ClientHeight);
  Canvas.LineTo(ClientWidth, 0);
end;

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
begin
  BeginPaint(Handle, PaintStruct);
  try
    if Assigned(FCanvas) then
    begin
      FCanvas.BeginDraw;
      try
        Paint;
      finally
        FCanvas.EndDraw;
      end;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
end;

procedure TForm1.WMSize(var Message: TWMSize);
var
  S: TD2DSizeU;
begin
  if Assigned(FCanvas) then
  begin
    S := D2D1SizeU(ClientWidth, ClientHeight);
    ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
  end;
  Invalidate;
  inherited;
end;

end.

这直接取自文档，除了一些改进：

1. 在CreateWnd 中（重新）创建画布之前，我更喜欢FreeAndNil。
2. 我更愿意确保画布分配在WMPaint。
3. 由于ID2D1HwndRenderTarget.Resize 方法使用var 参数，文档中的版本甚至无法编译，需要进行此调整。
4. 我想在调整大小时使表单无效。
5. 我回复WM_ERASEBKGND以避免闪烁。
6. 我更喜欢在表单被销毁时释放画布。
7. 我打开了内存泄漏报告。
8. 我画了一些视觉上令人印象深刻的图形。

有趣的是，如果我不在表单的析构函数中释放画布，我会收到内存泄漏报告，但我会得到一个 AV。这让我有点担心，但由于我通常不会泄露东西，所以我暂时忽略这部分。

当我使用 Delphi 10.3.2 编译它并在具有 125% DPI 的 Microsoft Windows 7（64 位，启用 Aero）系统上运行它时，我得到以下结果：

虽然我被令人惊叹的线条抗锯齿效果迷住了，但很明显，这不是我想要的图像。

问题似乎与 DPI 缩放有关，似乎以下简单调整可以解决问题：

procedure TForm1.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
begin
  BeginPaint(Handle, PaintStruct);
  try
    if Assigned(FCanvas) then
    begin
      FCanvas.BeginDraw;
      try
        // BEGIN ADDITION
        var f := 96 / Screen.PixelsPerInch;
        Canvas.RenderTarget.SetTransform(TD2DMatrix3x2F.Scale(f, f, D2D1PointF(0, 0)));
        // END ADDITION
        Paint;
      finally
        FCanvas.EndDraw;
      end;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
end;

但这在所有情况下都有效吗？这使得在OnPaint 中以正常方式使用转换工具是不可能的，不是吗？有更好的解决方案吗？ 正确的（最佳实践）解决方案是什么？

更新

“适用于我的系统”的不同解决方案是

procedure TForm1.CreateWnd;
begin
  inherited;
  FreeAndNil(FCanvas);
  FCanvas := TDirect2DCanvas.Create(Handle);
  FCanvas.RenderTarget.SetDpi(96, 96); // <-- Add this!
end;

但同样，我不确定这是否是“正确”的方法。

Answer 1

我看错了问题。具体来说，我使用的是 90 年代的 Win9x/GDI 眼镜。

来自 Microsoft Windows documentation 关于 Direct2D：

GDI 绘图以像素为单位。这意味着，如果您的程序被标记为 DPI 感知，并且您要求 GDI 绘制一个 200 × 100 的矩形，那么在屏幕上生成的矩形将是 200 像素宽和 100 像素高。

[...]

Direct2D 自动执行缩放以匹配 DPI 设置。在 Direct2D 中，坐标以称为设备无关像素 (DIP) 的单位测量。 DIP 定义为逻辑英寸的 1/96。在 Direct2D 中，所有绘图操作都在 DIP 中指定，然后缩放到当前 DPI 设置。

[...]

例如，如果用户的 DPI 设置为 144 DPI，并且您要求 Direct2D 绘制一个 200 × 100 的矩形，则该矩形将是 300 × 150 物理像素。

这解释了观察到的行为。

这不是错误或糟糕的设计——这是一个很棒的功能，现在我想到了。它使创建独立于 DPI 的应用程序变得更加容易。

当然，缺点是 Direct2D 使用的坐标系统与 VCL 使用的坐标系统不同。微软确实警告过我们：

请注意：鼠标和窗口坐标仍以物理像素而不是 DIP 给出。例如，如果您处理 WM_LBUTTONDOWN 消息，则鼠标按下位置以物理像素为单位给出。要在该位置绘制一个点，您必须将像素坐标转换为 DIP。

因此，正确的做法是在大多数绘图操作中坚持与分辨率无关的 Direct2D 坐标系，然后在必要时显式转换 GDI/窗口坐标和 Direct2D 坐标之间的尺寸，例如在绘制字符串时窗口的中心：

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
  S: string;
begin
  Canvas.RenderTarget.Clear(D2D1ColorF(clWhite));
  R := ClientRect;
  R.Width := MulDiv(R.Width, 96, Screen.PixelsPerInch);
  R.Height:= MulDiv(R.Height, 96, Screen.PixelsPerInch);
  S := 'Hello, Direct2D!';
  Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfCenter]);
  Canvas.MoveTo(0, 0);
  Canvas.LineTo(R.Width, R.Height);
  Canvas.MoveTo(0, R.Height);
  Canvas.LineTo(R.Width, 0);
end;