问题描述

我正在研究在某些应用程序中用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中创建画布，再CreateWnd。
我更愿意确保在WMPaint中分配了画布。
由于ID2D1Hwndrendertarget.Resize方法使用了var参数，因此文档中的版本甚至无法编译，因此需要进行调整。
我要在调整大小时使表格无效。
我回复WM_ERASEBKGND以避免闪烁。
我更喜欢在表单被破坏时释放画布。
我打开内存泄漏报告。
我画了一些视觉上令人印象深刻的图形。

有趣的是，如果我不释放窗体的析构函数中的画布，则会收到内存泄漏报告，但会得到一个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;

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

解决方法

我是用错误的眼镜看问题的。具体来说，我使用的是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物理像素。

这解释了观察到的行为。

这不是一个bug或糟糕的设计-既然我想到了，它就是一个很棒的功能。它使创建独立于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,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;

delphi delphi-10.3-rio direct2d dpi

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

问题描述

更新

解决方法