Wieder mal das leidige Thema "Flackern"

[Michael II]

Wenn du das nicht mit FireMonkey programmieren willst/kannst, dann lade doch mal Graphics32 runter und verwende Layers.

Ein gutes Beispiel findest du unter:
Graphics32\Examples\Vcl\Layers\Sprites_Ex


Du kannst BitMaps (inkl. Transparenz, also ARGB) definieren, und die Z-Order festlegen.

Wenn du die Dinger dann rumschiebst, gibst du lediglich die neuen Koordinaten der Bitmaps an.

Das Ganze läuft ruckelfrei und schnell.

[jziersch]

Das Flackern kommt meist durch das löschen des Hintergrundes durch windows.
Wenn man die wmerasebk o.ae. message des hintergrund objektes bzw. Form abfängt kann man das Flackern verhindern.
Sorry, kann gerade kein Beispiel bauen

[Uwe Raabe]

Einfach mal probeweise diese Klassendeklaration vor das Form schreiben, in dem die Paintbox liegt.

Delphi-Quellcode:

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

Die Implementierung ist relativ simpel.

Delphi-Quellcode:

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

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

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

[stahli]

Hier mal ein aktueller Stand meines oben beschriebenen Konzeptes: https://www.delphipraxis.net/1444229-post60.html
Das Formular dient quasi nur als leere Zeichenfläche.
Dadurch brauche ich keine Synchronisation verschiedener Zeichenvorgänge, muss aber eben auch alles selbst zeichnen.