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

Question

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

Значение по умолчанию DoubleBuffered на компонентах ложно.

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

Поскольку форма закрыта панелями, вероятно, можно перехватить ее сообщение 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 у меня есть две панели. Верхний выровнен alTop относительно формы и рассматривается как контейнер для кнопок. Другой выровнен 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.

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

Новое приложение 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.

Answer 1

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

Я думаю, что можно было бы также избежать любой операции в OnPaint, кроме растяжки-рисования непосредственно на ваш paintbox.Canvas, из вашего закадрового растрового изображения. Все остальное в OnPaint является потенциально фликкер-ошибкой. Это означает, что никакая модификация TBitmap изнутри OnPaint. Позвольте мне сказать это в третий раз; Не меняйте состояние в событиях рисования. События рисования должны содержать операцию "bitmap-blit", GDI-прямоугольник и вызовы строк и т. Д., Но не более того.

Я не рекомендую никому экспериментировать с WM_SETREDRAW, но это одна из техник, которую используют люди. Вы можете отследить события или сообщения окна перемещения / изменения размера и включить / выключить WM_SETREDRAW, но это ТАК чревато осложнениями и проблемами, которые я не рекомендую. Вы также можете вызвать различные функции Win32 для блокировки окна, и все они очень опасны и не рекомендуются.

Answer 2

Для чего это стоит, следующее без мерцания для меня:

unit uMainForm;

interface

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

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    FPnlCtrl, FPnlScene: TPanel;
    FPbScene: TPaintBox;
    procedure OnScenePaint(Sender: TObject);
  end;

implementation

{$R *.dfm}

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

  FPnlCtrl := TPanel.Create(Self);
  FPnlCtrl.Parent := Self;
  FPnlCtrl.Align := alTop;
  FPnlCtrl.Color := clPurple;

  FPnlScene := TPanel.Create(Self);
  FPnlScene.Parent := Self;
  FPnlScene.Align := alClient;
  FPnlScene.Color := clBlue;

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

  FPbScene.OnPaint := Self.OnScenePaint;
end;

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

end.