[Non-VCL] Zeichnen flackert

[Neutral General]

Hi,

Ich musste feststellen, dass es doch z.T. recht flackert, wenn man mit dem den GDI Funktionen auf ein non VCL Formular malt.

Folgender Code:

Delphi-Quellcode:

// Canvas: TCanvas <> Graphics.TCanvas sondern meine eigene non VCL Canvas Klasse

Canvas.Brush.Color := RGB(255,255,255);
Canvas.Rectangle(0,0,100,100);

Canvas.Brush.Color := RGB(2,255,255);
Canvas.Rectangle(50,50,300,300);

Vorallem in den Bereichen wo sich die Beispielquadrate überschneiden flackert es recht stark. Dem Formular habe ich schon WS_EX_COMPOSITED (Doublebuffered) verpasst und damit ist es auch besser, aber man siehts halt immernoch. In der VCL wäre das nicht so...

Ich zeige euch mal meine Canvas Unit. Ist bisher noch recht klein:

Delphi-Quellcode:

unit NVCLCanvas;

interface

uses Windows;

type
  TPen = class
  private
    FHandle: hPen;
    FColor: Cardinal;
    FOnChange: TNotifyEvent;
    procedure SetColor(const Value: Cardinal);
    procedure RecreatePen;
  public
    constructor Create;
    destructor Destroy; override;
    property Color : Cardinal read FColor write SetColor;
    property Handle: hPen read FHandle write FHandle;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TBrush = class
  private
    FHandle: hBrush;
    FColor: Cardinal;
    FOnChange: TNotifyEvent;
    procedure SetColor(const Value: Cardinal);
    procedure RecreateBrush;
  public
    constructor Create;
    destructor Destroy; override;
    property Color : Cardinal read FColor write SetColor;
    property Handle: hBrush read FHandle write FHandle;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;
  
  TCanvas = class
  private
    FHandle: HDC;
    FPen: TPen;
    FBrush: TBrush;
    procedure PenChange(Sender: TObject);
    procedure BrushChange(Sender: TObject);
    procedure SetHandle(const Value: HDC);
  public
    constructor Create(ADC: hDC); 
    destructor Destroy; override;
    property Handle: HDC read FHandle write SetHandle;
    property Pen: TPen read FPen;
    property Brush: TBrush read FBrush;
    procedure Rectangle(x1,y1,x2,y2: Integer);
  end;

implementation

{ TPen }

constructor TPen.Create;
begin
  inherited Create;
  FColor := RGB(0,0,0);
  FHandle := CreatePen(PS_SOLID,1,FColor);
end;

destructor TPen.Destroy;
begin
  DeleteObject(FHandle);
  inherited Destroy;
end;

procedure TPen.RecreatePen;
begin
  DeleteObject(FHandle);
  FHandle := CreatePen(PS_SOLID,1,FColor);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TPen.SetColor(const Value: Cardinal);
begin
  FColor := Value;
  RecreatePen;
end;

{ TBrush }

constructor TBrush.Create;
begin
  inherited Create;
  FColor := RGB(255,255,255);
  FHandle := CreateSolidBrush(FColor);
end;

destructor TBrush.Destroy;
begin
  DeleteObject(FHandle);
  inherited Destroy; 
end;

procedure TBrush.RecreateBrush;
begin
  DeleteObject(FHandle);
  FHandle := CreateSolidBrush(FColor);
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TBrush.SetColor(const Value: Cardinal);
begin
  FColor := Value;
  RecreateBrush;
end;

{ TCanvas }

constructor TCanvas.Create(ADC: hDC);
begin
  inherited Create;
  FHandle := ADC;
  // Pen zuweisen
  FPen := TPen.Create;
  FPen.OnChange := PenChange;
  SelectObject(FHandle,FPen.Handle);
  // Brush zuweisen
  FBrush := TBrush.Create;
  FBrush.OnChange := BrushChange;
  SelectObject(FHandle,FBrush.Handle);
end;

destructor TCanvas.Destroy;
begin
  FBrush.Free;
  FPen.Free;
  inherited Destroy;
end;

procedure TCanvas.BrushChange(Sender: TObject);
begin
  SelectObject(FHandle,FBrush.Handle);
end;

procedure TCanvas.PenChange(Sender: TObject);
begin
  SelectObject(FHandle,FPen.Handle);
end;

procedure TCanvas.Rectangle(x1, y1, x2, y2: Integer);
begin
  Windows.Rectangle(FHandle,x1,y1,x2,y2);
end;

procedure TCanvas.SetHandle(const Value: HDC);
begin
  FHandle := Value;
  FWinHandle := 0;
end;

end.

Weiß da jemand Bescheid?

Gruß
Neutral General