在受 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.

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

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

有趣的是，如果我不在窗体的析构函数中释放 canvas，我会收到内存泄漏报告，但我却得到了 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 drawing is measured in pixels. That means if your program is marked as DPI-aware, and you ask GDI to draw a 200 × 100 rectangle, the resulting rectangle will be 200 pixels wide and 100 pixels tall on the screen.

[...]

Direct2D automatically performs scaling to match the DPI setting. In Direct2D, coordinates are measured in units called device-independent pixels (DIPs). A DIP is defined as 1/96th of a logical inch. In Direct2D, all drawing operations are specified in DIPs and then scaled to the current DPI setting.

[...]

For example, if the user's DPI setting is 144 DPI, and you ask Direct2D to draw a 200 × 100 rectangle, the rectangle will be 300 × 150 physical pixels.

这解释了观察到的行为。

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

缺点当然是Direct2D 使用的坐标系与VCL 使用的不同。 Microsoft 确实就此警告我们：

A word of caution: Mouse and window coordinates are still given in physical pixels, not DIPs. For example, if you process the WM_LBUTTONDOWN message, the mouse-down position is given in physical pixels. To draw a point at that position, you must convert the pixel coordinates to DIPs.

因此，正确的做法是坚持使用 Direct2D 的 resolution-independent 坐标系进行大多数绘图操作，然后在必要时在 GDI/window 坐标和 Direct2D 坐标之间显式转换尺寸，例如就像在 window:

的中心绘制字符串一样

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;

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

Using Direct2D in a Delphi VCL application affected by DPI scaling

delphi

dpi

direct2d

delphi-10.3-rio

更新