Author: Tomas Rutkauskas
I am trying to display a list box that has an alternating background color for each
row. I realize I can do this by making the Listbox an owner draw list box and
setting the background color for each line when it is drawn. The problem here is
only the lines corresponding to existing items will be effected. Even if the
listbox has no items in it, I still want it to be displayed with the alternating
background colors.
Answer:
Solve 1:
It requires a combination of an OnDrawItem handler (or an overriden DrawItem
method) and a handler for WM_ERASEBKGND. See example below. For some reason the
WM_ERASEBKGND handler is not called when the listbox contains no items.
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls;
8
9 type
10 TListbox = class(Stdctrls.TListbox)
11 private
12 procedure wmEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
13 end;
14 TForm1 = class(TForm)
15 ListBox1: TListBox;
16 Button1: TButton;
17 procedure Button1Click(Sender: TObject);
18 procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
19 Rect: TRect; State: TOwnerDrawState);
20 private
21 { Private declarations }
22 public
23 { Public declarations }
24 end;
25
26 var
27 Form1: TForm1;
28
29 implementation
30
31 {$R *.DFM}
32
33 procedure TForm1.Button1Click(Sender: TObject);
34 var
35 i: Integer;
36 begin
37 for i := listbox1.items.count to listbox1.items.count + 5 do
38 listbox1.items.add(format('Item %d', [i]));
39 end;
40
41 { TListbox }
42 const
43 colors: array[Boolean] of TColor = ($FFFFC0, $C0FFFF);
44
45 procedure TListbox.wmEraseBkGnd(var msg: TWMEraseBkGnd);
46 var
47 cv: TCanvas;
48 h, max: Integer;
49 r: TRect;
50 b: Boolean;
51 begin
52 msg.result := 1;
53 h := Perform(LB_GETITEMHEIGHT, 0, 0);
54 if h = LB_ERR then
55 h := ItemHeight;
56 cv := TCanvas.Create;
57 try
58 cv.Handle := msg.DC;
59 r := Rect(0, 0, ClientWidth, h);
60 b := Odd(TopIndex) and (TopIndex >= 0);
61 max := ClientHeight;
62 cv.Brush.Style := bsSolid;
63 while r.Top < max do
64 begin
65 cv.Brush.Color := colors[b];
66 b := not b;
67 cv.FillRect(r);
68 OffsetRect(r, 0, h);
69 end;
70 finally
71 cv.Handle := 0;
72 cv.free;
73 end;
74 end;
75
76 procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
77 Rect: TRect; State: TOwnerDrawState);
78 var
79 cb, ct: TColor;
80 begin
81 if not (odSelected in State) then
82 with Control as TListbox do
83 begin
84 canvas.Brush.Color := colors[Odd(index)];
85 canvas.Brush.Style := bsSolid;
86 end;
87 Rect.Right := Control.ClientWidth;
88 with Control as TListbox do
89 begin
90 canvas.FillRect(Rect);
91 canvas.Brush.Style := bsClear;
92 canvas.TextRect(Rect, Rect.Left + 2, Rect.Top, Items[index]);
93 end;
94 end;
95
96 end.
Solve 2:
97
98 procedure TFrmAlignText.ListBoxDrawItem(Control: TWinControl;
99 Index: Integer; Rect: TRect; State: TOwnerDrawState);
100 var
101 horzOffset: integer;
102 vertOffset: integer;
103 begin
104 {ListBox.Style is set to lbOwnerDrawFixed.}
105 with ListBox.Canvas do
106 begin
107 {vertOffset added to Rect.Top causes the string to be vertically centered in
108 the rectangle}
109 vertOffset := (((Rect.Bottom - Rect.Top) - TextExtent(ListBox.Items[Index]).CY)
110 div 2);
111 {TextWidth('Mi') div 4 gives (roughly) half of an average character width}
112 horzOffset := TextWidth('Mi') div 4;
113 if not (odSelected in State) then
114 begin
115 if Odd(Index) then
116 begin
117 Brush.Color := clBtnFace;
118 Font.Color := clBtnText
119 end
120 else
121 begin
122 Font.Color := clFuchsia;
123 end;
124 end;
125 FillRect(Rect);
126 TextOut(Rect.Left + horzOffset, Rect.Top + vertOffset, ListBox.Items[Index]);
127 end;
128 end;
|
