Listview Ownerdraw

[wp_xxyyzz]

Hallo,

ich möchte die Einträge in einer Listview selbst zeichnen, um so bestimmte farbige Füllmuster anzuzeigen.

Auf einem Formular wird eine ListView und eine Paintbox verwendet. Die Listview hat den Viewtyle=vsReport und wird zu Demonstrationszwecken im OnCreate-Event des Formulars mit Werten gefüllt. Die Paintbox dient nur zum Vergleich.

Jeder Eintrag der Listview soll als rot schraffiertes Rechteck ausgegeben werden. Jedoch gelingt dies mit der Canvas.Routine "Rectangle" nicht, die Listview zeigt nur ein weißes Rechteck an. Der Zeichencode selbst ist in Ordnung, da die Paintbox richtig eingefärbt ist.

Offenbar macht die Listview irgendetwas mit dem Canvas, so dass sich die Rechteckausgabe über "Rectangle" seltsam verhält. Aber was?

Hier ist mein Code (Formular: TForm mit Standard-TListView und -TPaintbox; Delphi 7 Pro / Win2000):

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    PaintBox1: TPaintBox;
    procedure ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure DrawRect(ACanvas:TCanvas; ARect:TRect);
begin
  with ACanvas do begin
    // Hintergrund löschen
    Brush.Color := clWhite;
    Brush.Style := bsSolid;
    FillRect(ARect);
    InflateRect(ARect, -2, -2);
    // Rechteck zeichnen
    Pen.Color := clBlack;
    Pen.Style := psSolid;
    Brush.Color := clRed;
    Brush.Style := bsCross;
    Rectangle(ARect);
  end;
end;

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  R : TRect;
begin
  DefaultDraw := false;
  R := Item.DisplayRect(drBounds);
  DrawRect(Sender.Canvas, R);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with Listview1 do begin
    ViewStyle := vsReport;
    with Columns do begin
      Clear;
      with Add do Caption := 'Col1';
    end;
    with Items do begin
      Clear;
      with Add do begin
        Caption := 'dummy1';
      end;
      with Add do begin
        Caption := 'dummy2';
      end;
    end;
  end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
   DrawRect(Paintbox1.Canvas, Paintbox1.ClientRect);
end;

end.