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

Question

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

为此，我阅读了 Embarcadero 官方文档并创建了这个最小的 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. FreeAndNil在我（重新）创建它之前，我更喜欢画布CreateWnd。
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 眼镜。

来自关于 Direct2D的 Microsoft Windows文档：

GDI 绘图以像素为单位。这意味着如果您的程序被标记为 DPI-aware，并且您要求 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;