在DPI缩放影响下，在Delphi VCL应用程序中使用Direct2D

Question

我正在研究在我的应用程序中一些部分将GDI替换为Direct2D。

为此，我阅读了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. 在 CreateWnd 中重新创建画布前，我更喜欢使用 FreeAndNil 清空画布。
2. 我更喜欢确保在 WMPaint 中分配了画布。
3. 由于 ID2D1HwndRenderTarget.Resize 方法使用了一个 var 参数，因此文档中的版本甚至无法编译，需要进行调整。
4. 我想在调整大小时使表单失效。
5. 我响应 WM_ERASEBKGND 以避免闪烁。
6. 我更喜欢在表单销毁时释放画布。
7. 我打开了内存泄漏报告。
8. 我绘制了一些视觉上令人印象深刻的图形。

有趣的是，如果我不在表单的析构函数中释放画布，我会收到一个访问冲突错误（Access Violation），而不是内存泄漏报告。这让我有点担心，但由于我通常不会出现内存泄漏，所以我暂且忽略这部分。

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

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

问题似乎与 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;

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

- Andreas Rejbrand

Answer 1

我之前的视角错误了，我使用了90年代Win9x/GDI眼镜。

根据Microsoft Windows有关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使用的坐标系统。Microsoft确实警告我们：

请注意：鼠标和窗口坐标仍以物理像素而不是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;

- Andreas Rejbrand