list all directories, files and drives in a listbox? 
Author: GPS  

procedure TForm1.Button1Click(Sender: TObject); 
var 
   D: PChar; 
begin 
   D := 'C:\*.*'; 
   SendMessage(ListBox1.Handle, 
               LB_DIR, 
               DDL_ARCHIVE + 
               DDL_DIRECTORY + 
               DDL_DRIVES + 
               DDL_EXCLUSIVE + 
               DDL_HIDDEN + 
               DDL_READONLY + 
               DDL_READWRITE + 
               DDL_SYSTEM, 
               Integer(D)); 
end; 

//Oder: 
//Or: 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  D: PChar; 
begin 
   D := 'C:\*.*'; 
   ListBox2.Perform(LB_DIR, 
                    DDL_ARCHIVE + 
                    DDL_DIRECTORY + 
                    DDL_DRIVES + 
                    DDL_EXCLUSIVE + 
                    DDL_HIDDEN + 
                    DDL_READONLY + 
                    DDL_READWRITE + 
                    DDL_SYSTEM, 
                    Integer(d)); 
end; 

-----------------
access Listbox items with API? 
Author: Thomas Stutz  

{ 
  This code might be useful for nonVCL applications or to read Listbox 
  items from another application. 
} 


// Retrieve the number of items in a ListBox 
// Anzahl Einträge einer ListBox ermitteln 

function LB_GetItemCount(hListBox: THandle): Integer; 
begin 
  Result := SendMessage(hListBox, LB_GETCOUNT, 0, 0); 
end; 

// Delete a string in a ListBox 
// Einen String in einer ListBox löschen 

procedure LB_DeleteItem(hListBox: THandle; Index: Integer); 
begin 
  SendMessage(hListBox, LB_DELETESTRING, Index, 0); 
end; 

// Retrieve the selected item from a ListBox 
// Gibt den Text des markiertes Items einer ListBox zurück 

function LB_GetSelectedItem(hListBox: THandle): string; 
var 
  Index, len: Integer; 
  s: string; 
  buffer: PChar; 
begin 
  Index := SendMessage(hListBox, LB_GETCURSEL, 0, 0); 
  len := SendMessage(hListBox, LB_GETTEXTLEN, wParam(Index), 0); 
  GetMem(buffer, len + 1); 
  SendMessage(hListBox, LB_GETTEXT, wParam(Index), lParam(buffer)); 
  SetString(s, buffer, len); 
  FreeMem(buffer); 
  Result := IntToStr(Index) + ' : ' + s; 
end; 

// Example, Beispiel: 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  hListBox: THandle; 
begin 
  hListBox := {...}; // listbox handle 
  ListBox1.Items.Text := LB_GetSelectedItem(hListBox); 
end; 

// Retrieve a string from a ListBox 
// Gibt den Text eines bestimmten Items einer ListBox zurück 

function LB_GetListBoxItem(hWnd: Hwnd; LbItem: Integer): string; 
var 
  l: Integer; 
  buffer: PChar; 
begin 
  l := SendMessage(hWnd, LB_GETTEXTLEN, LbItem, 0); 
  GetMem(buffer, l + 1); 
  SendMessage(hWnd, LB_GETTEXT, LbItem, Integer(buffer)); 
  Result := StrPas(buffer); 
  FreeMem(buffer); 
end; 

// Example, Beispiel: 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  hListBox: THandle; 
begin 
  hListBox := {...}; // listbox handle 
  ListBox1.Items.Text := LB_GetListBoxItem(hListBox, 2); 
end; 

// Gibt den gesamten Text einer ListBox zurück 
// Retrieve all listbox items 

function LB_GetAllItems(hWnd: Hwnd; sl: TStrings): string; 
var 
  RetBuffer: string; 
  i, x, y: Integer; 
begin 
  x := SendMessage(hWnd, LB_GETCOUNT, 0, 0); 
  for i := 0 to x - 1 do 
  begin 
    y := SendMessage(hWnd, LB_GETTEXTLEN, i, 0); 
    SetLength(RetBuffer, y); 
    SendMessage(hWnd, LB_GETTEXT, i, lParam(PChar(RetBuffer))); 
    sl.Add(RetBuffer); 
  end; 
end; 

// Example, Beispiel: 

procedure TForm1.Button3Click(Sender: TObject); 
var 
  sl: TStringList; 
  ListBox_Handle: THandle; 
begin 
  hListBox := {...}; // listbox handle 
  sl := TStringList.Create; 
  try 
    LB_GetAllItems(ListBox_Handle, sl); 
  finally 
    ListBox1.Items.Text := sl.Text; 
    sl.Free; 
  end; 
end; 


-------------------------
show in-place Tooltips in a TListBox? 
Author: Happyjoe  
0 Comments to this tip [Write new comment] 
[ Print tip ]     

Tip Rating (0):   
Skill:   
Useful:   
Overall:   



{ 
  In-place ToolTips are used to display text strings for objects that have been clipped, 
  in TreeView for example. The following code has been tested only on standard ListBox. 
  Of cause you can use tips on other VCLs after appropriate modification. 
  (Only copy following code to your form1's unit file) 
} 

//------------------------------------------------------------------------------ 
//  Show in-place tooltips on ListBox 
//  Author£ºJoe Huang                 Email£ºHappyjoe@21cn.com 
// 
//------------------------------------------------------------------------------ 


unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, CommCtrl; 

type 
  //Override TListBox's WinProc to get CM_MOUSELEAVE message 
  TNewListBox = class(TListBox) 
  protected 
    { Protected declarations } 
    procedure WndProc(var Message: TMessage); override; 
  end; 

type 
  TForm1 = class(TForm) 
    Button2: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure Button2Click(Sender: TObject); 
  private 
    { Private declarations } 
    GHWND: HWND; 
    TipVisable: Boolean; 
    OldIndex, CurrentIndex: Integer; 
    ti: TOOLINFO; 
    ListBox1: TListBox; 

    procedure InitListBox;   //Create ListBox1 dynamically 
    procedure CreateTipsWindow;  //Create Tooltip Window 
    procedure HideTipsWindow;    //Hide Tooltip Window 

    //WM_NOTIFY message's handler, fill Tooltip Window content 
    procedure WMNotify(var Msg: TMessage); message WM_NOTIFY; 

    procedure ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X, 
      Y: Integer); 
    procedure ListBox_MouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.dfm} 

{ TNewListBox } 

procedure TNewListBox.WndProc(var Message: TMessage); 
begin 
  case Message.Msg of 
    CM_MOUSELEAVE: Form1.HideTipsWindow; 
  end; 
  inherited WndProc(Message); 
end; 

{ TForm1 } 

procedure TForm1.InitListBox; 
begin 
  ListBox1 := TNewListBox.Create(Self); 
  ListBox1.Parent := Self; 
  ListBox1.Left := 50; 
  ListBox1.Top := 50; 
  ListBox1.Width := 200; 
  ListBox1.Height := 200; 
  //append serveral items for testing 
  ListBox1.Items.Append('happyjoe'); 
  ListBox1.Items.Append('Please send me email: happyjoe@21cn.com'); 
  ListBox1.Items.Append('Delphi 5 Developer''s Guide'); 
  ListBox1.Items.Append('Delphi 5.X ADO/MTS/COM+ Advanced Development'); 

  ListBox1.OnMouseMove := ListBox_MouseMove; 
  ListBox1.OnMouseDown := ListBox_MouseDown; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Self.Font.Name := 'Tahoma'; 
  InitListBox; 
  CreateTipsWindow; 
end; 

procedure TForm1.CreateTipsWindow; 
var 
  iccex: tagINITCOMMONCONTROLSEX; 
begin 
  // Load the ToolTip class from the DLL. 
  iccex.dwSize := SizeOf(tagINITCOMMONCONTROLSEX); 
  iccex.dwICC := ICC_BAR_CLASSES; 
  InitCommonControlsEx(iccex); 

  // Create the ToolTip control. 
  GHWND := CreateWindow(TOOLTIPS_CLASS, '', 
                        WS_POPUP, 
                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 
                        Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 
                        0, 0, hInstance, 
                        nil); 

  // Prepare TOOLINFO structure for use as tracking ToolTip. 
  ti.cbSize := SizeOf(ti); 
  ti.uFlags := TTF_IDISHWND + TTF_TRACK + TTF_ABSOLUTE + TTF_TRANSPARENT; 
  ti.hwnd := Self.Handle; 
  ti.uId := ListBox1.Handle; 
  ti.hinst := hInstance; 
  ti.lpszText := LPSTR_TEXTCALLBACK; 
  ti.Rect.Left := 0; 
  ti.Rect.Top := 0; 
  ti.Rect.Bottom := 0; 
  ti.Rect.Right := 0; 

  SendMessage(GHWND, WM_SETFONT, ListBox1.Font.Handle, Integer(LongBool(False))); 
  SendMessage(GHWND,TTM_ADDTOOL,0,Integer(@ti)); 
end; 

procedure TForm1.WMNotify(var Msg: TMessage); 
var 
  phd: PHDNotify; 
  NMTTDISPINFO: PNMTTDispInfo; 
begin 
  phd := PHDNotify(Msg.lParam); 
  if phd.Hdr.hwndFrom = GHWND then 
  begin 
    if phd.Hdr.Code = TTN_NEEDTEXT then 
    begin 
      NMTTDISPINFO := PNMTTDispInfo(phd); 
      NMTTDISPINFO.lpszText := PChar(ListBox1.Items[CurrentIndex]); 
    end; 
  end; 
end; 

procedure TForm1.ListBox_MouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if TipVisable then     //when mouse down, hide Tooltip Window 
  begin 
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0); 
    TipVisable := False; 
  end; 
end; 

procedure TForm1.ListBox_MouseMove(Sender: TObject; Shift: TShiftState; X, 
  Y: Integer); 
var 
  Index: Integer; 
  APoint: TPoint; 
  ARect: TRect; 
  ScreenRect: TRect; 
begin 
  Index := ListBox1.ItemAtPos(Point(X, Y), true); 
  if Index = -1 then 
  begin 
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0); 
    OldIndex := -1; 
    TipVisable := False; 
    Exit; 
  end; 
  CurrentIndex := Index; 
  if Index = OldIndex then Exit; 
  if TipVisable then 
  begin 
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0); 
    OldIndex := -1; 
    TipVisable := False; 
  end else 
  begin 
    ARect := ListBox1.ItemRect(Index); 

    if (ARect.Right - ARect.Left - 2) >= ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) then 
    begin 
      OldIndex := -1; 
      Exit; 
    end; 
    APoint := ListBox1.ClientToScreen(ARect.TopLeft); 
    windows.GetClientRect(GetDesktopWindow, ScreenRect); 

    if ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) + APoint.X > ScreenRect.Right then 
      APoint.X := ScreenRect.Right - ListBox1.Canvas.TextWidth(ListBox1.Items[Index]) - 5; 
    SendMessage(GHWND, 
                TTM_TRACKPOSITION, 
                0, 
                MAKELPARAM(APoint.x - 1, APoint.y - 2)); 

    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(True)), Integer(@ti)); 
    OldIndex := Index; 
    TipVisable := True; 
  end; 
end; 

procedure TForm1.HideTipsWindow; 
begin 
  if TipVisable then 
  begin 
    SendMessage(GHWND,TTM_TRACKACTIVATE,Integer(LongBool(False)), 0); 
    OldIndex := -1; 
    TipVisable := False; 
  end; 
end; 

// Test it: 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
 InitListBox; 
 CreateTipsWindow; 
end; 

end. 

end. 
----------------------
set TListBox Items right aligned? 
Author: Rainer Kümmerle  
Homepage: http://www.delphimania.de 


procedure TForm1.FormCreate(Sender: TObject); 
begin 
  // Oder im Objektinspektor einstellen 
  // Or set in object inspector 
  ListBox1.Style := lbOwnerDrawFixed; 
end; 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var 
  l: Integer;  
  t: String; 
begin 
  with ListBox1 do 
  begin 
    Canvas.FillRect(Rect); 
    t := Items[Index];  
    l := Rect.Right - Canvas.TextWidth(t) - 1; 
    Canvas.TextOut(l, Rect.Top, t); 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ListBox1.Items.Add(Edit1.Text); 
end; 
--------------------
Drag & Drop items from a TListBox to a TRichEdit? 
Author: Thomas Stutz  
Homepage: http://www.swissdelphicenter.ch 
2 Comments to this tip [Write new comment] 
[ Print tip ]     

Tip Rating (0):   
Skill:   
Useful:   
Overall:   



function RECharIndexByPos(RichEdit: TRichEdit; X, Y: Integer): Integer; 
var 
  P: TPoint; 
begin 
  P := Point(X, Y); 
  Result := SendMessage(RichEdit.Handle, EM_CHARFROMPOS, 0, Longint(@P)); 
end; 


procedure TForm1.RichEdit1DragOver(Sender, Source: TObject; X, Y: Integer; 
  State: TDragState; var Accept: Boolean); 
var 
  P: TPoint; 
begin 
  // Check, if Source is ListBox1 
  Accept := Source = ListBox1; 
  if GetCursorPos(P) then 
    with RichEdit1 do 
    begin 
      // Get the Index from Mouse Position 
      P := ScreenToClient(P); 
      SelStart := RECharIndexByPos(RichEdit1, P.X, P.Y); 
      SetFocus; 
    end; 
end; 

procedure TForm1.RichEdit1DragDrop(Sender, Source: TObject; X, Y: Integer); 
begin 
  // finally insert text at mouse position 
  RichEdit1.SelText := ListBox1.Items[ListBox1.ItemIndex]; 
end; 

------------
...copy Listbox Items to the clipboard? 
Author: Thomas Stutz  

uses 
  Clipbrd; 

procedure ListBoxToClipboard(ListBox: TListBox; 
  BufferSize: Integer; 
  CopyAll: Boolean); 
var 
  Buffer: PChar; 
  Size: Integer; 
  Ptr: PChar; 
  I: Integer; 
  Line: string[255]; 
  Count: Integer; 
begin 
  if not Assigned(ListBox) then 
    Exit; 

  GetMem(Buffer, BufferSize); 
  Ptr   := Buffer; 
  Count := 0; 
  for I := 0 to ListBox.Items.Count - 1 do 
  begin 
    Line := ListBox.Items.strings[I]; 
    if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then 
      Continue; 
    { Check buffer overflow } 
    Count := Count + Length(Line) + 3; 
    if Count = BufferSize then 
      Break; 
    { Append to buffer } 
    Move(Line[1], Ptr^, Length(Line)); 
    Ptr    := Ptr + Length(Line); 
    Ptr[0] := #13; 
    Ptr[1] := #10; 
    Ptr    := Ptr + 2; 
  end; 
  Ptr[0] := #0; 
  ClipBoard.SetTextBuf(Buffer); 
  FreeMem(Buffer, BufferSize); 
end; 

procedure ClipboardToListBox(ListBox: TListbox); 
begin 
  if not Assigned(ListBox) then 
    Exit; 

  if not Clipboard.HasFormat(CF_TEXT) then 
    Exit; 

  Listbox.Items.Text := Clipboard.AsText; 
end; 


//Copy all items from Listbox1 to the clipboard 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ListBoxToClipboard(ListBox1, 1024, True); 
end; 

//Paste items in clipboard to Listbox2 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  ClipboardToListBox(Listbox2); 
end; 

//Copy only selected items from Listbox1 to the clipboard 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  ListBoxToClipboard(Listbox1, 1024, False); 
end; 

--------------------
drag & drop within a TListBox? 
Author: Thomas Stutz  


{ 
 This example shows how to drag&drop within a TListBox. 
 The Demo Program also shows how to implement an autoscroll-feature. 

} 

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer; 
  State: TDragState; var Accept: Boolean); 
begin 
  Accept := Sender is TListBox; 
end; 

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer); 
var 
  iTemp: Integer; 
  ptTemp: TPoint; 
  szTemp: string; 
begin 
  { change the x,y coordinates into a TPoint record } 
  ptTemp.x := x; 
  ptTemp.y := y; 

  { Use a while loop instead of a for loop due to items possible being removed 
   from listboxes this prevents an out of bounds exception } 
  iTemp := 0; 
   while iTemp <= TListBox(Source).Items.Count-1 do 
  begin 
    { look for the selected items as these are the ones we wish to move } 
    if TListBox(Source).selected[iTemp] then 
    begin 
      { use a with as to make code easier to read } 
      with Sender as TListBox do 
      begin 
      { need to use a temporary variable as when the item is deleted the 
        indexing will change } 
        szTemp := TListBox(Source).Items[iTemp]; 

        { delete the item that is being dragged  } 
        TListBox(Source).Items.Delete(iTemp); 

      { insert the item into the correct position in the listbox that it 
       was dropped on } 
        Items.Insert(itemAtPos(ptTemp, True), szTemp); 
      end; 
    end; 
    Inc(iTemp); 
  end; 
end; 

---------------
draw Bitmaps in a TListbox? 
Author: Jan 'eGo' Urbansky  
Homepage: http://uned.utstation.de/personal 


{ Create a TImage on your Formular and assign a bitmap } 
{ Create a TListbox on your Formular } 

type 
  TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Image1: TImage; 
    procedure FormCreate(Sender: TObject); 
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; 
      Rect: TRect; State: TOwnerDrawState); 
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer; 
      var Height: Integer); 
  private 
    {...} 
  public 
    {...} 
  end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with ListBox1.Items do 
  begin 
    Clear; 
    ListBox1.Style := lbOwnerDrawVariable; 
    AddObject('Bitmap1', Image1.Picture.Bitmap); 
    AddObject('Bitmap2', Image2.Picture.Bitmap); 
    AddObject('Bitmap3', Image3.Picture.Bitmap); 
  end; 
end; 

procedure CenterText(Cnv: TCanvas; Rect: TRect; S: string); 
var  
  X, Y: Integer; 
begin 
  X := (Rect.Right + Rect.Left - Cnv.TextWidth(S)) div 2; 
  Y := (Rect.Bottom + Rect.Top - Cnv.TextHeight(S)) div 2; 
  Cnv.TextOut(X, Y, S); 
end; 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var  
  Bitmap: TBitmap; 
begin 
  with ListBox1 do 
  begin 
    Canvas.FillRect(Rect); 
    if Items.Objects[Index] <> nil then 
    begin 
      Bitmap := Items.Objects[Index] as TBitmap; 
      Canvas.BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, 
        Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, 
        Bitmap.Height), Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]); 
    end; 
    Rect.Left   := Rect.Left + Bitmap.Width + 4; 
    Rect.Bottom := Rect.Top + Bitmap.Height + 4; 
    CenterText(Canvas, Rect, Items.Strings[Index]); 
  end; 
end; 

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; 
  var Height: Integer); 
begin 
  if Index = 0 then Height := Image1.Height + 4; 
end; 

---------------
delete all selected items of a Listbox? 
Author: Rainer Kümmerle  
Homepage: http://www.delphimania.de 


procedure TForm1.Button1Click(Sender: TObject); 
var 
  i: integer; 
begin 
  for i := ListBox1.Items.Count - 1 downto 0 do 
    if ListBox1.Selected[i] then 
      ListBox1.Items.Delete(i); 
end; 
---------------------
search and select an item in a TListBox? 
Author: Rainer Kümmerle  
Homepage: http://www.delphimania.de 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  search: string; 
begin 
  search := 'swissdelphicenter'; 
  if SendMessage(ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then 
    ShowMessage('Item selected: ' + IntToStr(ListBox1.ItemIndex)); 
end; 
-------------------
move items in a listbox? 
Author: Hammer  

// move an item up 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  CurrIndex: Integer; 
begin 
  if ListBox1.ItemIndex > 0 then 
  begin 
    CurrIndex := ListBox1.ItemIndex; 
    ListBox1.Items.Move(ListBox1.ItemIndex, (CurrIndex - 1)); 
    ListBox1.ItemIndex := CurrIndex - 1; 
  end; 
end; 

//move an item down 
  
procedure TForm1.Button2Click(Sender: TObject); 
var 
  CurrIndex, LastIndex: Integer; 
begin 
  CurrIndex := ListBox1.ItemIndex; 
  lastindex := ListBox1.Items.Count; 

  if ListBox1.ItemIndex <> -1 then 
  begin 
    if CurrIndex + 1 < lastindex then 
    begin 
      ListBox1.Items.Move(ListBox1.ItemIndex, (CurrIndex + 1)); 
      ListBox1.ItemIndex := CurrIndex + 1; 
    end; 
  end; 
end; 
----------------
display an alternating color for each TListBox row? 
Author: Peter Below  
Homepage: http://www.teamb.com 

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; // (!) ListBox1.Style := lbOwnerDrawFixed 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; 
      Rect: TRect; State: TOwnerDrawState); 
    { ... } 
  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. 
---------------