How to paint a TListBox with alternating background colours per row

Mirror

How to paint a TListBox with alternating background colours per row (Views: 36)

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;

<< Back to main page