Как устранить мерцание на правом краю TPaintBox (например, при изменении размера)

Резюме:
Скажем, у меня есть TForm и две панели. Панели выровнены по alTop и alClient. Панель alClient содержит TPaintBox, OnPaint которого включает коды рисования.

Значение по умолчанию DoubleBuffered для компонентов - false.

Во время процесса рисования мерцание очевидно, потому что форма, все панели окрашивают свой фон.

Поскольку форма покрыта панелями, она вероятно, нормально перехватить его сообщение WM_ERASEBKGND. В противном случае можно было бы увидеть мерцание на панелях и мерцание на правом краю панелей при изменении размера формы, потому что форма рисует фон.

Во-вторых, поскольку панель alTop предназначена для использования в качестве контейнера для некоторых кнопок, вероятно, можно установить для параметра DoubleBuffered значение true, чтобы позволить Delphi гарантировать отсутствие мерцания на нем. Вероятно, это не приведет к большой нагрузке на производительность.

В-третьих, поскольку панель alClient предназначена только как контейнер для другого компонента рисования, эта панель, скорее всего, не участвует в создании окончательного чертежа. В этом отношении, вероятно, лучше использовать потомка TPanel вместо стандартного TPanel. В этом потомке TPanel переопределите защищенную процедуру Paint и ничего не делайте внутри процедуры, особенно унаследованный вызов, чтобы избежать вызова FillRect в базовом классе TCustomPanel.Paint. Кроме того, перехватить сообщение WM_ERASEBKGND и также ничего не делать внутри. Это потому, что когда TPanel. ParentBackground имеет значение False, Delphi отвечает за перерисовку фона, а если установлено значение True, отвечает ThemeService.

Наконец, чтобы рисовать без мерцания в TPaintBox:
(1) Используя встроенные процедуры рисования VCL, вероятно, лучше, чтобы ...
(2) Использование OpenGL с включенным двойным буфером OpenGL.
(3) ...

=== Q: Как устранить мерцание на правом краю TPaintBox? ===

Предположим, что для одного TForm у меня есть две панели. Верхний выравнивается по высоте относительно формы и рассматривается как контейнер для кнопок. Другой выравнивается по alClient относительно формы и рассматривается как контейнер для компонентов отрисовки (например, TPaintBox из VCL или TPaintBox32 из Graphics32). Для последней панели перехватывается сообщение WM_ERASEBKGND.

Теперь я использую экземпляр TPaintBox в следующем примере кода. В обработчике OnPaint у меня есть два варианта рисования рисунка, который, как я ожидаю, будет без мерцания. Вариант 1 - рисование после заполнения прямоугольника. Поскольку его родительская панель не должна стирать фон, рисунок не должен мерцать. Вариант 2 опирается на TBitmap, холст которого затем копируется обратно в ящик для рисования.

Однако оба варианта мерцают, а второй вариант особенно мерцает. Меня больше всего беспокоит выбор 1. Если вы измените размер формы, вы увидите, что основная часть мерцания происходит на правом краю. Почему это происходит? Может ли кто-нибудь помочь прокомментировать причину и возможное решение? (Обратите внимание: если я использую TPaintBox32 вместо TPaintBox здесь, правый край вообще не будет мерцать.)

Мое вторичное беспокойство заключается в том, что при выборе варианта 1 незначительная часть мерцания происходит на блоке рисования случайным образом. Это не очень очевидно, но все же наблюдается, если вы быстро измените размер формы. Кроме того, при использовании варианта 2 это мерцание становится намного более сильным. Причину этого я не нашел. Может ли кто-нибудь помочь прокомментировать возможную причину и решение?

Любое предложение приветствуется !!

    unit uMainForm;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      ExtCtrls, Dialogs;

    type
      TMainForm = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
        FPnlCtrl, FPnlScene: TPanel;
        FPbScene: TPaintBox;

        OldPnlWndProc: TWndMethod;

        procedure PnlWndProc(var Message: TMessage);
        procedure OnScenePaint(Sender: TObject);
      public
        { Public declarations }
      end;

    var
      MainForm: TMainForm;

    implementation

    {$R *.dfm}

    procedure TMainForm.FormCreate(Sender: TObject);
    begin
      Self.Color := clYellow;
      Self.DoubleBuffered := False;

      FPnlCtrl := TPanel.Create(Self);
      FPnlCtrl.Parent := Self;
      FPnlCtrl.Align := alTop;
      FPnlCtrl.Color := clPurple;
      FPnlCtrl.ParentColor := False;
      FPnlCtrl.ParentBackground := False;
      FPnlCtrl.FullRepaint := False;
      FPnlCtrl.DoubleBuffered := False;

      FPnlScene := TPanel.Create(Self);
      FPnlScene.Parent := Self;
      FPnlScene.Align := alClient;
      FPnlScene.Color := clBlue;
      FPnlScene.ParentColor := False;
      FPnlScene.ParentBackground := False;
      FPnlScene.FullRepaint := False;
      FPnlScene.DoubleBuffered := False;

      FPbScene := TPaintBox.Create(Self);
      FPbScene.Parent := FPnlScene;
      FPbScene.Align := alClient;
      FPbScene.Color := clRed;
      FPbScene.ParentColor := False;

      //
      OldPnlWndProc := Self.FPnlScene.WindowProc;
      Self.FPnlScene.WindowProc := Self.PnlWndProc;

      FPbScene.OnPaint := Self.OnScenePaint;

    end;

    procedure TMainForm.PnlWndProc(var Message: TMessage);
    begin
      if (Message.Msg = WM_ERASEBKGND) then
        Message.Result := 1
      else
        OldPnlWndProc(Message);
    end;

    procedure TMainForm.OnScenePaint(Sender: TObject);
    var
      tmpSceneBMP: TBitmap;
    begin
      // Choice 1
       FPbScene.Canvas.FillRect(FPbScene.ClientRect);
       FPbScene.Canvas.Ellipse(50, 50, 150, 150);

      // Choice 2
    //  tmpSceneBMP := TBitmap.Create;
    //  tmpSceneBMP.Width := FPbScene.ClientWidth;
    //  tmpSceneBMP.Height := FPbScene.ClientHeight;
    //  tmpSceneBMP.Canvas.Brush.Color := FPbScene.Color;
    //  tmpSceneBMP.Canvas.FillRect(FPbScene.ClientRect);
    //  tmpSceneBMP.Canvas.Ellipse(50, 50, 150, 150);
    //  FPbScene.Canvas.CopyRect(FPbScene.ClientRect, tmpSceneBMP.Canvas,
    //    FPbScene.ClientRect);

    end;

    end.

=== Q: Как правильно остановить перерисовку фона панелью? ===
(Если я задам это отдельным вопросом, просто скажите об этом, и я удалю это.)

Создайте приложение VCL, вставив образец кода, прикрепите FormCreate, запустите отладку. Теперь наведите указатель мыши на форму, и вы увидите, что панель явно перекрашивает свой фон. Однако, как показано в примере кода, я уже должен был перехватить это поведение, перехватив сообщение WM_ERASEBKGND.

Обратите внимание: если я закомментирую эти три строки,

FPnlScene.Color := clBlue;
FPnlScene.ParentColor := False;
FPnlScene.ParentBackground := False;  

, тогда сообщение WM_ERASEBKGND может быть захвачено. Я понятия не имею об этой разнице.

Не могли бы вы прокомментировать причину такого поведения, и как правильно перехватить сообщение WM_ERASEBKGND (когда ParentBackground: = False)?

    unit Unit1;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      ExtCtrls, Dialogs;

    type
      TForm1 = class(TForm)
        procedure FormCreate(Sender: TObject);
      private
        { Private declarations }
        FPnlScene: TPanel;
        FPbScene: TPaintBox;

        FOldPnlWndProc: TWndMethod;

        procedure PnlWndProc(var Message: TMessage);

        procedure OnSceneMouseMove(Sender: TObject; Shift: TShiftState;
          X, Y: Integer);
        procedure OnScenePaint(Sender: TObject);
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Self.Color := clYellow;
      Self.DoubleBuffered := False;

      FPnlScene := TPanel.Create(Self);
      FPnlScene.Parent := Self;
      FPnlScene.Align := alClient;
      FPnlScene.Color := clBlue;
      FPnlScene.ParentColor := False;
      FPnlScene.ParentBackground := False;
      FPnlScene.FullRepaint := False;
      FPnlScene.DoubleBuffered := False;

      FPbScene := TPaintBox.Create(Self);
      FPbScene.Parent := FPnlScene;
      FPbScene.Align := alClient;
      FPbScene.Color := clRed;
      FPbScene.ParentColor := False;

      //
      FOldPnlWndProc := Self.FPnlScene.WindowProc;
      Self.FPnlScene.WindowProc := Self.PnlWndProc;

      Self.FPbScene.OnMouseMove := Self.OnSceneMouseMove;
      Self.FPbScene.OnPaint := Self.OnScenePaint;

    end;

    procedure TForm1.PnlWndProc(var Message: TMessage);
    begin
      if Message.Msg = WM_ERASEBKGND then
      begin
        OutputDebugStringW('WM_ERASEBKGND');
        Message.Result := 1;
      end
      else
        FOldPnlWndProc(Message);
    end;

    procedure TForm1.OnSceneMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    begin
      FPbScene.Repaint;
    end;

    procedure TForm1.OnScenePaint(Sender: TObject);
    begin
      FPbScene.Canvas.FillRect(FPbScene.ClientRect);
      FPbScene.Canvas.Ellipse(50, 50, 150, 150);
    end;

    end.