2010. február 16., kedd
How to paint a TListBox with alternating background colours per row
Problem/Question/Abstract:
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.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TListbox = class(Stdctrls.TListbox)
private
procedure wmEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
end;
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := listbox1.items.count to listbox1.items.count + 5 do
listbox1.items.add(format('Item %d', [i]));
end;
{ TListbox }
const
colors: array[Boolean] of TColor = ($FFFFC0, $C0FFFF);
procedure TListbox.wmEraseBkGnd(var msg: TWMEraseBkGnd);
var
cv: TCanvas;
h, max: Integer;
r: TRect;
b: Boolean;
begin
msg.result := 1;
h := Perform(LB_GETITEMHEIGHT, 0, 0);
if h = LB_ERR then
h := ItemHeight;
cv := TCanvas.Create;
try
cv.Handle := msg.DC;
r := Rect(0, 0, ClientWidth, h);
b := Odd(TopIndex) and (TopIndex >= 0);
max := ClientHeight;
cv.Brush.Style := bsSolid;
while r.Top < max do
begin
cv.Brush.Color := colors[b];
b := not b;
cv.FillRect(r);
OffsetRect(r, 0, h);
end;
finally
cv.Handle := 0;
cv.free;
end;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
cb, ct: TColor;
begin
if not (odSelected in State) then
with Control as TListbox do
begin
canvas.Brush.Color := colors[Odd(index)];
canvas.Brush.Style := bsSolid;
end;
Rect.Right := Control.ClientWidth;
with Control as TListbox do
begin
canvas.FillRect(Rect);
canvas.Brush.Style := bsClear;
canvas.TextRect(Rect, Rect.Left + 2, Rect.Top, Items[index]);
end;
end;
end.
Solve 2:
procedure TFrmAlignText.ListBoxDrawItem(Control: TWinControl;
Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
horzOffset: integer;
vertOffset: integer;
begin
{ListBox.Style is set to lbOwnerDrawFixed.}
with ListBox.Canvas do
begin
{vertOffset added to Rect.Top causes the string to be vertically centered in the rectangle}
vertOffset := (((Rect.Bottom - Rect.Top) - TextExtent(ListBox.Items[Index]).CY) div 2);
{TextWidth('Mi') div 4 gives (roughly) half of an average character width}
horzOffset := TextWidth('Mi') div 4;
if not (odSelected in State) then
begin
if Odd(Index) then
begin
Brush.Color := clBtnFace;
Font.Color := clBtnText
end
else
begin
Font.Color := clFuchsia;
end;
end;
FillRect(Rect);
TextOut(Rect.Left + horzOffset, Rect.Top + vertOffset, ListBox.Items[Index]);
end;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése