Wieder mal das leidige Thema "Flackern"

[Uwe Raabe]

Zitat von jziersch:

Bei der TPaintBox klappt das nicht. Das muss ein WinControl sein. Also am besten in dem TForm welches das unmittelbare parent der TPaintBox ist.

Richtig

Hier mal ein Beispiel, wie es funktionieren könnte:

Delphi-Quellcode:

object Form448: TForm448
  Left = 0
  Top = 0
  Caption = 'Form448'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 0
    Top = 0
    Width = 635
    Height = 299
    Align = alClient
    OnMouseMove = PaintBox1MouseMove
    OnPaint = PaintBox1Paint
    ExplicitLeft = 137
    ExplicitTop = 80
    ExplicitWidth = 105
    ExplicitHeight = 105
  end
end

Delphi-Quellcode:

unit Unit448;

interface

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

type
  TForm448 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormResize(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    FBitmap: TBitmap;
    function GetBitmap: TBitmap;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  public
    destructor Destroy; override;
    property Bitmap: TBitmap read GetBitmap;
  end;

var
  Form448: TForm448;

implementation

{$R *.dfm}

destructor TForm448.Destroy;
begin
  FBitmap.Free;
  inherited Destroy;
end;

procedure TForm448.FormResize(Sender: TObject);
begin
  Bitmap.SetSize(ClientWidth, ClientHeight);
end;

function TForm448.GetBitmap: TBitmap;
begin
  if FBitmap = nil then begin
    FBitmap := TBitmap.Create;
  end;
  Result := FBitmap;
end;

procedure TForm448.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Bitmap.Canvas.Brush.Color := clGray;
  Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
  Bitmap.Canvas.TextOut(10, 10, FormatDateTime('c', Now));
  Bitmap.Canvas.MoveTo(0, Y);
  Bitmap.Canvas.LineTo(Width, Y);
  PaintBox1.Invalidate;
end;

procedure TForm448.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(Paintbox1.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm448.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

end.