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!
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!
Delphi-Quelltext
1: 2: 3:
| ... ListBox1.ItemHeight := 16; ... |
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:
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; begin Bmp := TBitmap.Create; try with (Control as TListbox) do begin Bmp.Transparent := True; 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; |
Beispiel:
Die DrawListBox Prozedur (oben) ist universal einsetzbar und kann aus verschieden Prozeduren gleichzeitig aufgerufen werden. Hier aus der OnDrawItem Ereignisprozedur der ListBox1:
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:
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; begin Bmp := TBitmap.Create; try with (Control as TListbox) do begin Bmp.Transparent := True; 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; |
Beispiel:
Die DrawListBox Prozedur (oben) ist universal einsetzbar und kann aus verschieden Prozeduren gleichzeitig aufgerufen werden. Hier aus der OnDrawItem Ereignisprozedur der ListBox1:
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:
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; 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;
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; |
Hier jetzt das DrawListBox Beispiel:
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;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin DrawListBoxExtra(Control, Index, Rect, State); end; |
Hier alles starten:
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]