[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

[bigg]

Zeichne deine Grafiken, Texte vorher auf einen Puffer (eine Bitmap) und anschließend auf das Formular.

[Neutral General]

Hi,

Daran dachte ich auch schon, aber ich komme mit nonVCL Bitmaps nicht klar. Hat da jemand ein Beispiel?

[bigg]

Schau in die Unit "Graphics.pas" oder riskier einen Blick ins msdn.
Link: http://msdn.microsoft.com/en-us/library/ms532305

[Neutral General]

Hi,

Wenn ich das richtig verstanden habe, dann muss ich so vorgehen:

Delphi-Quellcode:

var bmp: HBitmap;
    bmpdc: HDC;
begin
  bmp := CreateBitmap(Width,Height,1,24);
  bmpdc := SelectObject(??,bmp);
  Windows.Rectangle(bmpdc,0,0,Width,Height); // bitmap mit rechteck ausfüllen
end;

Was für ein DC muss jetzt allerdings bei SelectObject übergeben werden? Oder mach ichs komplett falsch?

Gruß
Neutral General

[Apollonius]

Wenn ich mich nicht täusche, geht es so:

Delphi-Quellcode:

var BufferDC: HDC; Bmp, OldBmp: HBITMAP;

BufferDC := CreateCompatibleDC(RealDC);
Bmp := CreateCompatibleBitmap(BufferDC, Width, Height);
OldBmp := SelectObject(BufferDC, Bmp);

//auf BufferDC zeichnen

//BufferDC auf RealDC blitten

SelectObject(BufferDC, OldBmp);
DeleteObject(Bmp);

DeleteDC(BufferDC);

[Neutral General]

Hi,

Danke Apollonius :)

Es funktioniert... Also prinzipiell zumindest..

Das Ergebnis sieht allerdings nicht so hübsch aus (siehe Anhang).

Gruß
Neutral General

[Flocke]

Gib bei "CreateCompatibleBitmap" mal den echten Bildschirm-DC ("RealDC") als ersten Parameter an und nicht "BufferDC".

P.S. normalerweise räumt man auf, indem man mit SelectObject in einen DC selektierte GDI-Objekte wiederherstellt (SelectObject gibt das Handle des vorher selektierten Objekts zurück). Also in TCanvas.Create die beiden Rückgabewerte von SelectObject sichern und in TCanvas.Destroy mit SelectObject wiederherstellen bevor man die momentan eigenen mit DeleteObject löscht.

[Neutral General]

Zitat:

Zitat von Flocke

Gib bei "CreateCompatibleBitmap" mal den echten Bildschirm-DC ("RealDC") als ersten Parameter an und nicht "BufferDC".

P.S. normalerweise räumt man auf, indem man mit SelectObject in einen DC selektierte GDI-Objekte wiederherstellt (SelectObject gibt das Handle des vorher selektierten Objekts zurück). Also in TCanvas.Create die beiden Rückgabewerte von SelectObject sichern und in TCanvas.Destroy mit SelectObject wiederherstellen bevor man die momentan eigenen mit DeleteObject löscht.

:kiss: :mrgreen: