Я изучаю возможность замены 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. Я предпочитаю FreeAndNil холст перед тем, как (повторно) создать его в CreateWnd.
2. Я предпочитаю убедиться, что холст назначен в WMPaint.
3. Поскольку метод ID2D1HwndRenderTarget.Resize использует параметр var, версия в документации даже не компилируется и нуждается в этой корректировке.
4. Я хочу аннулировать форму при изменении размера.
5. Я отвечаю на WM_ERASEBKGND, чтобы не мерцать.
6. Я предпочитаю освобождать холст, когда форма разрушена.
7. Я включаю отчет об утечке памяти.
8. Я рисую визуально впечатляющую графику.

Интересно, что если я не освобожу холст в деструкторе формы, то ожидаю отчета об утечке памяти, но вместо этого получаю AV. Это меня немного беспокоит, но, поскольку я обычно ничего не сливаю, я просто проигнорирую эту часть на данный момент.

Когда я компилирую это с помощью Delphi 10.3.2 и запускаю его в системе Microsoft Windows 7 (64-разрядная версия с поддержкой Aero) с разрешением 125% 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;

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