How to eliminate the flicker on the right edge of TPaintBox (for example when resizing)

只谈情不闲聊 提交于 2019-12-22 04:56:05

问题


Summarization:
Say that I have a TForm and two panels. The panels are aligned alTop and alClient. The alClient panel contains a TPaintBox, whose OnPaint involve drawing codes.

The default value of DoubleBuffered on the components are false.

During the drawing process, flicker is obvious because the form, the panels all paint their background.

Because the form is covered by the panels, it is probably fine to intercept its WM_ERASEBKGND message. If not, one could see flickering on the panels, and flickering on the right edge of the panels when the form is resized, because form paints its background.

Secondly, because the alTop panel is intended to be a container for some buttons, it is probably fine to set its DoubleBuffered to true to let Delphi ensure there is no flicker on it. It probably won't introduce much performance burden.

Thirdly, because the alClient panel is intended only to be a container for another drawing component, this panel is most likely not involved in composing the final drawing. In this respect, it's probably good to use a TPanel descendant instead of a standard TPanel. In this TPanel descendant, override the protected procedure Paint and do nothing inside the procedure, especially not the inherited call to avoid the FillRect call in the base class TCustomPanel.Paint. Furthermore, intercept the WM_ERASEBKGND message and also do nothing inside. This is because when the TPanel.ParentBackground is False, Delphi is responsible for repainting the background, and when it is True, ThemeService is responsible.

Lastly, to paint without flicker in the TPaintBox:
(1) Using VCL built-in drawing routines, it is probably better that...
(2) Using OpenGL, with OpenGL's double buffer enabled.
(3) ...

===Q: How to eliminate the flicker on the right edge of TPaintBox?===

Suppose that for one TForm, I have two panels on it. The top one is aligned alTop relative to the form and considered as a container for buttons. The other one is aligned alClient relative to the form and considered as a container for drawing components (such as TPaintBox from VCL, or TPaintBox32 from Graphics32). For the latter panel, its WM_ERASEBKGND message is intercepted.

Now, I use a TPaintBox instance in the following sample code. In its OnPaint handler, I have two choices to draw a drawing that I would expect to be flicker-free. Choice 1 is drawing after filling the rect. Because its parent panel should not erase the background, the drawing should be flicker-free. Choice 2 is drawing onto a TBitmap, whose Canvas is then copied back to the paintbox.

However, both choices are flickering, and the 2nd choice is especially flickering. My main concern is regarding choice 1. If you resize the form, you could see the main part of the flickering occurs on the right edge. Why does this happen? Could some one help to comment on the reason and possible solution? (Note, if I use TPaintBox32 instead of TPaintBox here, the right edge will not flicker at all.)

My secondary concern is that when using choice 1, the minor part of the flickering occurs on the paintbox randomly. It is not very obvious but still observable if you rapidly resize the form. Furthermore, when using choice 2, this kind of flickering becomes much more severe. I didn't find the reason of this. Could some one help to comment on the possible reason and solution?

Any suggestion is appreciated!!

    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: How to intercept the panel's repainting its background correctly? ===
(If I should ask this in a separate question, just say so and I will delete this.)

New a VCL application, pasting the sample code in, attach the FormCreate, run debug. Now hover the mouse over the form, you could see the panel is clearly repainting its background. However, as shown in the sample code, I should already intercepted this behaviour by intercepting the WM_ERASEBKGND message.

Note, if I comment out this three lines,

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

then the WM_ERASEBKGND message can be captured. I have no clue about this difference.

Could some one help to comment on the reason of this behavior, and how to intercept WM_ERASEBKGND message correctly (when 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.

回答1:


The usual technique is to play with form.DoubleBuffered, which I see you are already doing in code, so if it was that easy, I would think you would have solved it already.

I think one could also perhaps avoid any operation in the OnPaint other than a stretch-draw directly onto your paintbox.Canvas, from your offscreen bitmap. Anything else in OnPaint is a potentially flicker-inducing mistake. That means, no modification of the TBitmap from within the OnPaint. Let me say that a third time; Don't change state in paint events. Paint events should contain a "bitmap-blit" operation, GDI rectangle and line calls, etc, but nothing else.

I hesitate to recommend to anyone that they experiment with WM_SETREDRAW, but it is one technique people use. You can catch the move/resize window events or messages, and turn WM_SETREDRAW on/off, but this is SO fraught with complications and problems, that I don't recommend it. You can also call various Win32 functions to lock a window, and these are all highly dangerous and not recommended.




回答2:


For what it's worth, the following is flicker-free for me:

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.


来源:https://stackoverflow.com/questions/5186729/how-to-eliminate-the-flicker-on-the-right-edge-of-tpaintbox-for-example-when-re

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!