PaintBox flackert trotz Double Buffer

[Muhkopp]

Hallo

Ich wollte mir ein kleines Tool bauen und verzweifle ein bisschen an dem Flackern meiner PaintBox.
Nachdem mir die Google-Anfrage-Begriffe ausgehen, wollte ich mal die Profis fragen

Mein Tool sollte ein rahmenloses Vollbildfenster darstellen, das komplett mit einer PaintBox gefüllt ist. Diese sollte im Onpaint ganz klassisch ein TBitmap zeichnen und gut. Im MouseMove wird PaintBox.Invalidate aufgerufen, jedoch flackert der Zeichenvorgang im MouseMove ganz fürchterlich.


Für die rahmenlose Vollbildeinstellung habe ich folgenden Schnipsel gefunden (und dankbar benutzt):

Delphi-Quellcode:

procedure FormVollbild (const aForm :TForm);
var
  i : Integer;
begin
  aForm.BorderStyle := bsNone;
  i := (aForm.Width - aForm.ClientWidth) div 2;  
  aForm.SetBounds(-i,-i,(Screen.Width + 2*i),(Screen.Height + 2*i));
end;

Danach wird ein Bitmap in Größe des Zeichenbereichs erstellt, und eine Kopie davon.

Im MouseMove der PaintBox passiert dann:

Delphi-Quellcode:

procedure TVollbildForm.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  fBmpZeichnen.Assign(fBmpVorlage);
  { Hier wird etwas in fBmpZeichnen.Canvas gezeichnet }
  PaintBox.Invalidate;
end;

Das OnPaint der PaintBox sieht so aus:

Delphi-Quellcode:

procedure TVollbildForm.PaintBoxPaint(Sender: TObject);
begin
  PaintBox.Canvas.Draw(0,0,fBmpZeichnen);
//  BitBlt(PaintBox.Canvas.Handle,0,0,PaintBox.Width,PaintBox.Height,fBmpZeichnen.Canvas.Handle,0,0,SRCCOPY);
end;

Die Form hat (außer den Default-Werten von XE8)
KeyPreview := true;
BorderStyle := bsNone;
Außerdem rufe ich die Form mit ShowModal auf (natürlich nach einem TForm.Create(nil)).

So weit, so gut.

Wie man schon sieht, habe ich BitBlt wie auch Draw gestestet, beides mal leider das selbe traurige Ergebnis.
Ich habe die Form mit aktivem DoubleBuffer, aber auch schon ohne probiert: mit dem standard Windows-Stil habe ich im Bildaufbau immer einen Moment, in dem die Paintbox auf ihre Hintergrundfarbe zurück springt, bevor das Bitmap wieder angezeigt wird. Das ist nicht das gleiche flackern, als wenn ich direkt auf die PaintBox zeichnen würde, aber trotzdem optisch abschreckend.

Wenn ich einen der Embarcadero UI-Styles benutze (ich habe Obsidian probiert), dann habe ich verrückterweiße so ein wildes Flackern, als ob ich direkt in der PaintBox kachelweiße das Bitmap einzeichnen würde, anstatt komplett in einem Rutsch. Gibt es dazu irgendwelche Erkenntnisse, für mich wirkt das fast wie ein Bug...

Ich habe auch schon jeweils Release-Versionen erzeugt, es liegt also auch nicht am Debugger.

Ich benutze
Embarcadero XE8 Delphi (v22.0.19027.8951)
Windows 7 x64 Enterprise (neuster Updatestand)


Ich bin für alle Hinweiße dankbar, wenn gewünscht kann ich auch gern noch mehr Code nachliefern, ich wollte den Beitrag nicht noch länger machen.

Liebe Grüße, der Muhkopp

[TiGü]

Mach dir mal eine Interceptorklasse von TPanel!
Platziere ein TPanel auf die Form und packe deine Paintbox hinein.
Nun noch WM_ERASEBKGND abfangen und es flackert nicht mehr.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TPanel = class(Vcl.ExtCtrls.TPanel)
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  end;

  TForm1 = class(TForm)
    PaintBox: TPaintBox;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure PaintboxMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure PaintBoxPaint(Sender: TObject);
  private
    fBmpZeichnen: TBitmap;
    fBmpVorlage: TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  fBmpVorlage := TBitmap.Create;
  fBmpVorlage.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.bmp');
  fBmpZeichnen := TBitmap.Create;
  fBmpZeichnen.Assign(fBmpVorlage);
end;

procedure TForm1.PaintboxMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  fBmpZeichnen.Assign(fBmpVorlage);
  { Hier wird etwas in fBmpZeichnen.Canvas gezeichnet }
  PaintBox.Invalidate;
end;

procedure TForm1.PaintBoxPaint(Sender: TObject);
begin
  PaintBox.Canvas.Draw(0, 0, fBmpZeichnen);
end;

{ TPanel }
procedure TPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 0;
end;

end.

[Muhkopp]

Es funktioniert, vielen Dank!!!

Nur verstanden hab ich es noch nicht richtig *grins*

Kam das Flackern also daher, dass Windows eine Zeichenroutine triggert, die die Komponente in der Hintergrundfarbe füllt?
Und das Message.Result := 0; löscht diesen Aufruf??

[himitsu]

WM_ERASEBKGND > Remarks

[Der schöne Günther]

Schön wenn es funktioniert, aber verstanden habe ich das jetzt ehrlich gesagt auch nicht.

Mir war das Flackern in den VCL-Anwendungen immer so peinlich dass ich jegliches "Mit-Resizen" bei Verändern der Fenstergröße abgestellt habe und erst wenn der Benutzer mit dem Resizing des Fensters aufhört alles neu auszurichten.

Das Panel behandelt also WM_ERASEBKGND nicht mehr und daher gilt "If the application returns zero, the window will remain marked for erasing". Was soll denn hier erased werden? Und warum? Ich verstehe das nicht.

[himitsu]

Mal den Hintergrund neu ... der neue und eventuell teiltransparente Vordergund kommt gleich (z.B. ein Label oder nicht voll ausgemalte Paintbox)

Bei kleinen und teilweise volltransparenten Vordergründen funktioniert das und ist auch nötig.
Bei großen untransparenten Vollbildvordergründen ist es unnötig und manchmal störend.

Windows weiß nicht was vorne drauf liegt, also erstmal alles platt machen ... dat passt (fast) immer.

Eine Paintbox ist per se nunmal transparent. (wenn man nicht in jedes Pixel was rein malt)
Aber vor dem Malen weiß Windows das nicht, also muß man es ihm sagen (WM_ERASEBKGND > Result).
Eine TPaintbox ist auch keine eigenständige Komponente (für Windows), sondern malt auf das Canvas seines Parents, womit man es dem Parent sagen muß.