Hallo liebe Delphianer!
Ich habe hier ein mittelschweres Problem mit einem (offensichtlichen)
VCL-Bug.
Nicht, das ich mit dem Event nicht schon gearbeitet habe, aber laut der Beschreibung auf der Seite
DelphiDabbler
unter dem Punkt
Bugs in Delphi implementation
Zitat:
There can be some problems with font rendering...
und
Zitat:
You can get round some of the problems by using the Windows
GDI API directly rather than depending on the Canvas property.
können Probleme auftreten. Ich benutzte eine ähnliche Vorgehensweise an einer anderen Stelle und dort konnte ich das Problem so umgehen, daß ich die weiße
Zeile nicht ganz weiß, sondern
rgb(254,255,255) gemacht habe.
Folgendes einfaches Beispiel sollte mein Problem klar machen.
Es soll ein Bitmap auf den ListView gemalt werden und jede zweite Zeile leicht eingefärbt.
Soweit, sogut.
Jetzt kommt das Problem, das nach dem Knopfdruck (Bitmap wird erstellt und repaint auf ListView)
kommt es zu einem Rendering Problem mit den Fonts hinter der Bitmap-Spalte.
Hier mein SourceCode zur Erklärung:
Delphi-Quellcode:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls,StdCtrls;
type
TForm1 =
class(TForm)
ListView1: TListView;
Button1: TButton;
procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
procedure ListView1AdvancedCustomDrawSubItem(Sender: TCustomListView;
Item: TListItem; SubItem: Integer; State: TCustomDrawState;
Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
procedure Button1Click(Sender: TObject);
private
FBitmap : TBitmap;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{*******************************************************************************
* description :
*******************************************************************************}
procedure TForm1.Button1Click(Sender: TObject);
begin
FBitmap := TBitmap.Create;
FBitmap.Canvas.Create;
FBitmap.Height := 12;
FBitmap.Width := 12;
FBitmap.Canvas.Ellipse(0,0,12,12);
ListView1.Repaint;
end;
{*******************************************************************************
* description :
*******************************************************************************}
procedure TForm1.ListView1AdvancedCustomDrawItem( Sender: TCustomListView;
Item: TListItem;
State: TCustomDrawState;
Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
begin
if Stage = cdprePaint
then
begin
if (Item.
Index mod 2) = 0
then
Sender.Canvas.Brush.Color :=
rgb(255,255,255)
else
Sender.Canvas.Brush.Color :=
rgb(0,245,245);
end;
end;
{*******************************************************************************
* description :
*******************************************************************************}
procedure TForm1.ListView1AdvancedCustomDrawSubItem( Sender: TCustomListView;
Item: TListItem;
SubItem: Integer;
State: TCustomDrawState;
Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
_R : TPoint;
begin
if FBitmap <>
nil then
begin
if (SubItem = 2)
then
begin
sender.Canvas.Draw(125, Item.Position.Y, FBitmap);
end;
end;
end;
end.
vielleicht noch kurz das kleine Projekt als Anhang.