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

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

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

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

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

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

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

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

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

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

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

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

моя вторичная озабоченность заключается в том, что при использовании выбора 1 незначительная часть мерцания происходит на paintbox случайным образом. Это не очень очевидно, но все же заметно, если вы быстро измените размер формы. Кроме того, при использовании выбор 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.
7
delphi doublebuffered flicker paintbox tpanel

2 ответов

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

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

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

4

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

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