...eine Bitmap dem Text in einer ListBox voranstellen?

Popov · Verfasst: Do 12.02.04 21:49

Eine Bitmap dem Text in einer ListBox voranstellen?

Eine kleine Bitmap[meta]Bild[/meta] von dem Text eines ListBox Items wertet die ListBox immer auf. Dazu nutzt man das Ereignis OnDrawItem der ListBox. Diese bietet ein Canvas zum zeichnen und ein Rect-Bereich in den gezeichnet werden darf.

Zuerst muß allerdings die TListBox.Style Eigenschaft auf lbOwnerDrawFixed (oder lbOwnerDrawVariable bei variablen Höhen) gestellt werden. Wenn man das nicht macht, dann wird nicht gezeichnet.

Wichtig!

markieren

Delphi-Quelltext

1:
2:
3:

  ... 
  ListBox1.Style := lbOwnerDrawFixed; 
  ...

Entweder im Code einstellen oder bereits in Objektinspektor.

Auch sehr wichtig ist, daß man die Eigenschaft ItemHeight auf die Höhe der Bitmap einstellt oder die Bitmap auf ItemHeight. Wenn man also eine 16x16 Pixel große Bitmap hat, sollte auch ItemHeight mindestens den Wert 16 haben.

Wichtig!

markieren

Delphi-Quelltext

1:
2:
3:

  ... 
  ListBox1.ItemHeight := 16; // oder andere Bitmap-Höhe
  ...

Entweder im Code einstellen oder bereits in Objektinspektor.

Die Prozedur ist allgemein aufgebaut und kann aus jeder OnDrawItem Prozedur aufgerufen werden. Die Parameter der Prozedur sind die gleichen wie bei der OnDrawItem Prozedur. Man muß die Variablenbezeichnungen einfach nur übertragen. Das einzige Problem sind die Bitmap. Wo kriegt man sie her? Hier in der Prozedur hab ich drei Beispiele für Möglichkeiten vermerkt: von der Festplatte laden, aus einer Ressorce oder aus einer ListBox. Gibt es keine Bitmap, dann passt sich die Prozedur an und zeichnet nichts:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:

procedure DrawListBoxB(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  Col2: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  Bmp: TBitmap;
  TopDif: Integer; // Gleicht die Höhendifferenz aus
begin
  Bmp := TBitmap.Create;
  try 
    with (Control as TListbox) do 
    begin
      Bmp.Transparent := True;
      { Hier Bitmap von Festplatte laden }
      { Beispiel }
      //Bmp.LoadFromFile('c:\Bmp16.bmp');

      { Hier Bitmap aus Ressorce laden }
      { Beispiel }
      //Bmp.LoadFromResourceName(HInstance,'Bitmap1');

      { Hier Bitmap aus ImageList laden}
      { Beispiel mit ImageList1 auf Formular Form1 }
      //with Form1 do ImageList1.GetBitmap(0, Bmp);

      if odSelected in State then 
        Canvas.Font.Color := clCaptionText
      else 
        Canvas.Font.Color := Col2[(Control as TListbox).Enabled];

      TopDif := (ItemHeight div 2) - (Canvas.TextHeight(#32) div 2);
      Canvas.TextRect(Rect, Rect.Left + Bmp.Width + 1, Rect.Top + TopDif, Items[Index]);
      Canvas.Draw(Rect.Left, Rect.Top, Bmp);
    end 
  finally 
    Bmp.Free;
  end;
end; {Popov}

Beispiel:

Die DrawListBox Prozedur (oben) ist universal einsetzbar und kann aus verschieden Prozeduren gleichzeitig aufgerufen werden. Hier aus der OnDrawItem Ereignisprozedur der ListBox1:

markieren

Quelltext

1:
2:
3:
4:
5:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
begin 
  DrawListBoxB(Control, Index, Rect, State); 
end;

Hier noch Zebrapapier-Effekt mit Bitmap:

Das ist fast die gleiche Prozedur wie oben, nur daß hier zusätzlich noch ein Zebrapapier-Effekt angeboten wird:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:

procedure DrawListBoxZCB(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  Col1: array [Boolean] of TColor = ($00F8F8F8, clWindow);
  Col2: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  Bmp: TBitmap;
  TopDif: Integer; // Gleicht die Höhendifferenz aus
begin
  Bmp := TBitmap.Create;
  try 
    with (Control as TListbox) do 
    begin
      Bmp.Transparent := True;
      { Hier Bitmap von Festplatte laden }
      { Beispiel }
      //Bmp.LoadFromFile('c:\Bmp16.bmp');

      { Hier Bitmap aus Ressorce laden }
      { Beispiel }
      //Bmp.LoadFromResourceName(HInstance,'Bitmap1');

      { Hier Bitmap aus ImageList laden}
      { Beispiel mit ImageList1 auf Formular Form1 }
      //with Form1 do ImageList1.GetBitmap(0, Bmp);

      if odSelected in State then 
        Canvas.Font.Color := clCaptionText 
      else
      begin
        Canvas.Brush.Color := Col1[Odd(Index)];
        Canvas.Font.Color := Col2[(Control as TListbox).Enabled];
      end;

      TopDif := (ItemHeight div 2) - (Canvas.TextHeight(#32) div 2);
      Canvas.TextRect(Rect, Rect.Left + Bmp.Width + 1, Rect.Top + TopDif, Items[Index]);
      Canvas.Draw(Rect.Left, Rect.Top, Bmp);
    end;
  finally 
    Bmp.Free; 
  end;
end; {Popov}

Beispiel:

Die DrawListBox Prozedur (oben) ist universal einsetzbar und kann aus verschieden Prozeduren gleichzeitig aufgerufen werden. Hier aus der OnDrawItem Ereignisprozedur der ListBox1:

markieren

Quelltext

1:
2:
3:
4:
5:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
begin 
  DrawListBoxZCB(Control, Index, Rect, State); 
end;

----------------------------------------------

Hier ein kleines Anwendungsbeispiel für die obere Prozeduren!

Aus einer ListBox wird ein eigene DateiListBox. Nach dem Klick auf den Button1 werden Daten (des aktuellen Projektordners) geladen und mit passenden Icons versehen.

Dazu hab ich mir paar weitere Funktionen ausgeliehen: GetAllFilesExtra läd die Datenliste, IcoToBmpA konvertiert die Icons in Bitmaps und GetIconFromFileB die die Icons für die Dateien holt:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:

uses
  ShellApi;

procedure GetAllFilesExtra(List: TStrings);
var
  Path: String;
  Search: TSearchRec;
begin
  Path := ExtractFilePath(ParamStr(0));

  if FindFirst(Path + '*.*', faAnyFile, Search) = 0 then
  try
    repeat
      if (Search.Attr <> faDirectory) and (Search.Name[1] <> '.') then
        List.Add(Path + Search.Name);
    until FindNext(Search) <> 0;
  finally 
    FindClose(Search);
  end;
end;

procedure IcoToBmpA(Ico: TIcon; Bmp: TBitmap; SmallIcon: Boolean); 
var 
  WH: Byte; // Width and Height
begin 
  with Bmp do 
  begin 
    Canvas.Brush.Color := clFuchsia; 
    TransparentColor := clFuchsia; 

    Width := 32; Height := 32;
    Canvas.Draw(0, 0, Ico); 

    if SmallIcon then 
      WH := 16 
    else 
      WH := 32; 
    Canvas.StretchDraw(Rect(0, 0, WH, WH), Bmp); 
    Width := WH; Height := WH; 

    Transparent :=  True; 
  end; 
end; {Popov}

procedure GetIconFromFileB(const FileName: String; Icon: TIcon;
  SmallIcon: Boolean);
var 
  sfi: TSHFILEINFO; 
const 
  uFlags : array[Boolean] of DWord = (SHGFI_LARGEICON, SHGFI_SMALLICON); 
begin 
  if SHGetFileInfo(PChar(FileName), 0, sfi, SizeOf(sfi), SHGFI_ICON or
     uFlags[SmallIcon]) <> 0 then 
    Icon.Handle := sfi.hIcon; 
end; {Popov}

Hier jetzt das DrawListBox Beispiel:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:

procedure DrawListBoxExtra(Control: TWinControl; Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
const
  Col1: array [Boolean] of TColor = ($00F8F8F8, clWindow);
  Col2: array [Boolean] of TColor = (clInactiveCaptionText, clWindowText);
var
  Icon: TIcon;
  Bmp: TBitmap;
begin
  with (Control as TListbox) do 
  begin
    Icon := TIcon.Create;
    Bmp := TBitmap.Create;
    try
      if odSelected in State then 
        Canvas.Font.Color := clCaptionText
      else 
      begin
        Bmp.Canvas.Brush.Color := Canvas.Brush.Color;
        Canvas.Brush.Color := Col1[Odd(Index)];
        Canvas.Font.Color := Col2[(Control as TListBox).Enabled];
      end;
      GetIconFromFileB(Items[Index], Icon, True);
      IcoToBmpA(Icon, Bmp, True);
      Canvas.TextRect(Rect, Rect.Left + Bmp.Width + 2, Rect.Top + 2, Items[Index]);
      Canvas.Draw(Rect.Left, Rect.Top, Bmp);
    finally
      Bmp.Free;
      Icon.Free;
    end;
  end;
end; {Popov}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  DrawListBoxExtra(Control, Index, Rect, State);
end;

Hier alles starten:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox1.Style := lbOwnerDrawFixed;
  ListBox1.ItemHeight := 17;

  GetAllFilesExtra(ListBox1.Items);
end;

Moderiert von jasocul: Anpassung an den Style-Guide
Moderiert von jasocul: Beitrag geprüft am 13.05.2006
[meta]Zebraeffekt Zebra Bitmap Symbol ListBox TListBox[/meta]

_________________
Popov

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme