Using Direct2D in a Delphi VCL application affected by DPI scaling

Question

I am investigating replacing GDI with Direct2D in some parts of my applications.

To this end, I read the official Embarcadero documentation and created this minimal Direct2D application:

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.

This is taken directly from the documentation, except for a few improvements:

1. I prefer to FreeAndNil the canvas before I (re)create it in CreateWnd.
2. I prefer to make sure that the canvas is assigned in WMPaint.
3. Since the ID2D1HwndRenderTarget.Resize method uses a var parameter, the version in the documentation doesn't even compile and needs this adjustment.
4. I want to invalidate the form on resize.
5. I respond to WM_ERASEBKGND to avoid flickering.
6. I prefer to free the canvas when the form is destroyed.
7. I turn on memory leak reporting.
8. I draw some visually impressive graphics.

Interestingly, if I do not free the canvas in the form's destructor, I would expect a memory leak report, but instead I get an AV. This worries me a bit, but since I usually don't leak things, I'll just ignore that part for the moment.

When I compile this using Delphi 10.3.2 and run it on a Microsoft Windows 7 (64-bit, Aero enabled) system with 125% DPI, I get this result:

Although I am mesmerised by the stunning antialiasing of the lines, clearly, this was not the image I had in mind.

It seems like the problem is related to DPI scaling, and it seems like the following simple adjustment resolves the issue:

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;

But will this work in all circumstances? And this makes it impossible to use the transform facility the normal way in one's OnPaint, doesn't it? Is there a better solution? What's the right (best-practice) solution?

Update

A different solution that "works on my system" is

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

But again, I am not sure if this is the "right" approach.

Answer 1

I was looking at the problem through the wrong glasses. Specifically, I was using my Win9x/GDI glasses from the '90s.

From the Microsoft Windows documentation about 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.

This explains the observed behaviour.

And this isn't a bug or poor design -- it's a great feature, now that I think of it. It makes creating DPI-independent applications much easier.

The downside, of course, is that the coordinate system used by Direct2D differs from the one used by the VCL. And Microsoft does warn us about this:

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.

Hence, the right thing to do is to stick with the resolution-independent coordinate system of Direct2D for most drawing operations, and then explicitly convert dimensions between GDI/window coordinates and Direct2D coordinates whenever necessary, such as when drawing a string in the centre of a 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;