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

Question

Суммирование:
Скажите, что у меня есть 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 у меня есть две панели.Верхний выровнен 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.