Add a background image to Listbox
1. Create a form
2. Put a ComboBox and Listbox
3. Change Component's Style to csOwnerDrawVariable and ListBox's Style to lbOwnerDrawVariable.
4. Declare 5 global variables of TBitmap
5. Override Form's OnCreate.
6. overwrite the OnDraw of ComboBox.
7. overwrite the OnMeasureItem of ComboBox.
8. Release the resource in Form OnClose.
Unit Ownerdrw;
Interface
Uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
Type
TForm1 = class (TForm)
Combox1: TComboBox;
ListBox1: TListBox;
Procedure FormCreate (Sender: TObject );
Procedure FormClose (Sender: TObject; var Action: TCloseAction );
Procedure ComboBox1DrawItem (Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
Procedure ComboBox1MeasureItem (Control: TWinControl; Index: Integer;
Var Height: Integer );
Procedure ListBox1DrawItem (Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
Procedure ListBox1MeasureItem (Control: TWinControl; Index: Integer;
Var Height: Integer );
Private
{Private declarations}
Public
{Public declarations}
End;
Var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5: TBitmap;
Implementation
{$ R *. DFM}
Procedure TForm1.FormCreate (Sender: TObject );
Begin
TheBitmap1: = TBitmap. Create;
TheBitmap1.LoadFromFile ('C: delphiimagesuttonsglobe.bmp ');
TheBitmap2: = TBitmap. Create;
TheBitmap2.LoadFromFile ('C: delphiimagesuttonsvideo.bmp ');
TheBitmap3: = TBitmap. Create;
TheBitmap3.LoadFromFile ('C: delphiimagesuttonsgears.bmp ');
TheBitmap4: = TBitmap. Create;
TheBitmap4.LoadFromFile ('C: delphiimagesuttonskey.bmp ');
TheBitmap5: = TBitmap. Create;
TheBitmap5.LoadFromFile ('C: delphiimagesuttonsools.bmp ');
ComboBox1.Items. AddObject ('bitmap1: Globe ', TheBitmap1 );
ComboBox1.Items. AddObject ('bitmap2: video', TheBitmap2 );
ComboBox1.Items. AddObject ('bitmap3: Gears ', TheBitmap3 );
ComboBox1.Items. AddObject ('bitmap4: key', TheBitmap4 );
ComboBox1.Items. AddObject ('bitmap5: tools', TheBitmap5 );
ListBox1.Items. AddObject ('bitmap1: Globe ', TheBitmap1 );
ListBox1.Items. AddObject ('bitmap2: video', TheBitmap2 );
ListBox1.Items. AddObject ('bitmap3: Gears ', TheBitmap3 );
ListBox1.Items. AddObject ('bitmap4: key', TheBitmap4 );
ListBox1.Items. AddObject ('bitmap5: tools', TheBitmap5 );
End;
Procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction );
Begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
End;
Procedure TForm1.ComboBox1DrawItem (Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
Var
Bitmap: TBitmap;
Offset: Integer;
Begin
With (Control as TComboBox). Canvas do
Begin
FillRect (Rect );
Bitmap: = TBitmap (ComboBox1.Items. Objects [Index]);
If Bitmap <> nil then
Begin
BrushCopy (Bounds (Rect. Left + 2, Rect. Top + 2, Bitmap. Width,
Bitmap. Height), Bitmap, Bounds (0, 0, Bitmap. Width,
Bitmap. Height), clRed );
Offset: = Bitmap. width + 8;
End;
{Display the text}
TextOut (Rect. Left + Offset, Rect. Top, Combobox1.Items [Index])
End;
End;
Procedure TForm1.ComboBox1MeasureItem (Control: TWinControl; Index:
Integer; var Height: Integer );
Begin
Height: = 20;
End;
Procedure TForm1.ListBox1DrawItem (Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState );
Var
Bitmap: TBitmap;
Offset: Integer;
Begin
With (Control as TListBox). Canvas do
Begin
FillRect (Rect );
Bitmap: = TBitmap (ListBox1.Items. Objects [Index]);
If Bitmap <> nil then
Begin
BrushCopy (Bounds (Rect. Left + 2, Rect. Top + 2, Bitmap. Width,
Bitmap. Height), Bitmap, Bounds (0, 0, Bitmap. Width,
Bitmap. Height), clRed );
Offset: = Bitmap. width + 8;
End;
{Display the text}
TextOut (Rect. Left + Offset, Rect. Top, Listbox1.Items [Index])
End;
End;
Procedure TForm1.ListBox1MeasureItem (Control: TWinControl; Index: Integer;
Var Height: Integer );
Begin
Height: = 20;
End;
End.
// DFM file of the form
Object Form1: TForm1
Left = 1, 211
Maximum = 155
Width = 435
Height = 300
Caption = 'form1'
Font. Color = clWindowText
Font. Height =-13
Font. Name = 'system'
Font. Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
Object ComboBox1: TComboBox
Left = 26
Top = 30
Width = 165
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
End
Object ListBox1: TListBox
Left = 1, 216
Top = 28
Width = 151
Height = 167
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
End
End