Einzelnen Beitrag anzeigen

TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 Beiträge
 
Delphi 10.4 Sydney
 
#2

AW: PaintBox flackert trotz Double Buffer

  Alt 9. Sep 2015, 10:24
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.
  Mit Zitat antworten Zitat