Delphi - Direct2D - Paintbox drawing is flickering

[Achille PACE 0]

Delphi 11 - Windows 64 bits

I am trying to draw various things in a TPaintBox using TDirect2D. I need to constantly update what's drawn inside. Unfortunately, my TPaintBox is flickering when I'm modifying it.

I reproduced my problem in a small simpler project.

.dfm:

    object FormMain: TFormMain
      Left = 0
      Top = 0
      Caption = 'FormMain'
      ClientHeight = 968
      ClientWidth = 1470
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -12
      Font.Name = 'Segoe UI'
      Font.Style = []
      TextHeight = 15
      object PaintBox: TPaintBox
        AlignWithMargins = True
        Left = 20
        Top = 20
        Width = 1389
        Height = 928
        Margins.Left = 20
        Margins.Top = 20
        Margins.Right = 20
        Margins.Bottom = 20
        Align = alLeft
        OnMouseMove = PaintBoxMouseMove
        OnPaint = PaintBoxPaint
      end
    end

.pas:

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TFormMain = class(TForm)
    PaintBox: TPaintBox;
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxPaint(Sender: TObject);
  private
    { Déclarations privées }
    Index: Integer;
  public
    { Déclarations publiques }
  end;

var
  FormMain: TFormMain;

implementation

uses
  Vcl.Direct2D, Winapi.D2D1;

{$R *.dfm}

procedure TFormMain.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  PaintBox.Invalidate();
end;

procedure TFormMain.PaintBoxPaint(Sender: TObject);
var
  LCanvas: TDirect2DCanvas;
  Poly: array of TPoint;
begin
  LCanvas := TDirect2DCanvas.Create(PaintBox.Canvas, ClientRect);
  LCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE);
  LCanvas.BeginDraw;

  try
    { Drawing goes here }
    LCanvas.Pen.Color := clRed;
    LCanvas.Brush.Color := clNone;
    LCanvas.Pen.Width := 5;

    SetLength(Poly, 4);
    Poly[0] := Point(LCanvas.Pen.Width div 2 + Index, LCanvas.Pen.Width div 2 + Index);
    Poly[1] := Point(PaintBox.Width - LCanvas.Pen.Width, LCanvas.Pen.Width div 2);
    Poly[2] := Point(PaintBox.Width - LCanvas.Pen.Width, PaintBox.Height - LCanvas.Pen.Width);
    Poly[3] := Point(LCanvas.Pen.Width div 2, PaintBox.Height - LCanvas.Pen.Width);
    LCanvas.Polygon(Poly);
    inc(Index);

    LCanvas.MoveTo(10, 10);
    LCanvas.LineTo(PaintBox.Width - 10 - LCanvas.Pen.Width, PaintBox.Height - 10 - LCanvas.Pen.Width);
  finally
    LCanvas.EndDraw;
    LCanvas.Free;
  end;
end;

end.

Putting the form's double buffered property to true stops the flickering. But if I put the TPaintBox inside a TPanel (whose double buffered property is also set to true), it starts flickering again, which makes me think there is another problem.

I have also tried putting my TPaintBox in a frame, and adding that frame to my form (either by interface, or dynamically, and neither worked).

Edited April 11 by Achille PACE
Forgot a part of the code

[PeaShooter_OMO 11]

..

Edited April 11 by PeaShooter_OMO

[Der schöne Günther 316]

I am not familiar with Direct2D, but confused nonetheless - Wouldn't you need a HWND to paint into? And a TPaintBox is not a window control, it's a simple TGraphicControl descendant - Meaning you may probably paint onto your form or into that very panel, but I fail to see how a Paintbox is even remotely helpful.

 

Thanks for updating the code snippet.

Didn't know you can also create a TDirect2DCanvas pointing to a Canvas, instead of a HWND.

Edited April 11 by Der schöne Günther

[Achille PACE 0]

I used a TPaintBox because that's how mostly everything works in our 20 years old project. I'm a recent employee, but from what the senior dev told me, it was not possible to paint into a HWND and we had to paint into a TPaintBox's canvas.

I have tried painting into a Panel's handle and it seems to work.

 

Thanks !