Delphi - Direct2D - Paintbox 绘图闪烁

Question

Delphi 11 - Windows 64 位

我正在尝试使用 TDirect2D 在 TPaintBox 中绘制各种东西。我需要不断更新里面画的东西。不幸的是，我的 TPaintBox 在修改时闪烁。

我在一个更简单的小项目中重现了我的问题。

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

将表单的双缓冲属性设置为 true 可停止闪烁。但是如果我将 TPaintBox 放在 TPanel 中（其双缓冲属性也设置为 true），它又开始闪烁，这让我觉得还有另一个问题。

我还尝试将我的 TPaintBox 放入框架中，然后将该框架添加到我的表单中（通过界面或动态方式，但都不起作用）。

Answer 1

正如@Brian 所说，我研究了仅使用 Direct2D 画布。 似乎已经奏效了。 这是我的小示例使用此方法的样子：

.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 Panel: TPanel
        Left = 800
        Top = 264
        Width = 377
        Height = 401
        TabOrder = 0
      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, Vcl.Direct2D;

type
  TFormMain = class(TForm)
    Panel: TPanel;
  protected
    procedure CreateWnd; override;

    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  private
    { Déclarations privées }
    Index: Integer;
    FCanvas: TDirect2DCanvas;
  public
    { Déclarations publiques }
    property Canvas: TDirect2DCanvas read FCanvas;
  end;

var
  FormMain: TFormMain;

implementation

uses
  Winapi.D2D1;

{$R *.dfm}

procedure TFormMain.CreateWnd;
begin
  inherited;
  FCanvas := TDirect2DCanvas.Create(Panel.Handle);
end;

procedure TFormMain.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
  LPoly: array of TPoint;
begin
  BeginPaint(Panel.Handle, PaintStruct);

  try
    FCanvas.BeginDraw;
    try
      FCanvas.Pen.Color := clRed;
      FCanvas.Brush.Color := clNone;
      FCanvas.Pen.Width := 5;

      SetLength(LPoly, 4);

      LPoly[0] := Point(FCanvas.Pen.Width div 2 + Index, FCanvas.Pen.Width div 2 + Index);
      LPoly[1] := Point(Panel.Width - FCanvas.Pen.Width, FCanvas.Pen.Width div 2);
      LPoly[2] := Point(Panel.Width - FCanvas.Pen.Width, Panel.Height - FCanvas.Pen.Width);
      LPoly[3] := Point(FCanvas.Pen.Width div 2, Panel.Height - FCanvas.Pen.Width);

      FCanvas.Polygon(LPoly);
      Inc(Index);
      Paint;
    finally
      FCanvas.EndDraw;
    end;
  finally
    EndPaint(Panel.Handle, PaintStruct);
  end;
end;

end.

即使没有双缓冲也不会闪烁。 我直接在 TPanel 中绘画。

谢谢大家！