{ DEMO Unit for owner-draw listbox with bitmaps. }
{ }
{ Written by Jeff Atwood, JAtwood159@AOL.COM, or on CIS as 76743,3276. }
{}
{ Note: for this code to work when cut n' pasted, you must set the listbox }
{ style to lbOwnerDrawVariable or lbOwnerDrawFixed as necessary. Also      }
{ be sure to set the OnDrawItem and OnMeasureItem events to the procedures }
{ below. }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;

const
  BORDER = 4; { this is the spacing between objects above, below }
              { and between the text and the picture }

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    btnAdd: TButton;
    GroupBox1: TGroupBox;
    btnLoad: TButton;
    Edit1: TEdit;
    Label2: TLabel;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Label3: TLabel;
    procedure btnAddClick(Sender: TObject);
    procedure btnLoadClick(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bitmaps: Array [1..100] of TBitmap;
  bitIndex: Integer;
  loadedHt: Integer;

implementation

{$R *.DFM}

procedure TForm1.btnAddClick(Sender: TObject);
begin
  { create a new bitmap in the array (up to 100)    }
  { and make the object point to this array element }
  { I got burned BAD when I first tried to do this  }
  { by having all the objects point to              }
  { an image control. Change the image control pic  }
  { and it caused all the previously loaded images  }
  { to GPF.. they were still pointing to the OLD    }
  { image! }
  { Also, this is kind of inefficient since I       }
  { assume that 100 DIFFERENT bitmaps could be used }
  { if you are using one or two bitmaps, by all     }
  { means have multiple references to the same pic  }
  { to save memory. }
  bitIndex := bitIndex + 1;
  bitmaps[bitIndex] := TBitmap.Create;
  bitmaps[bitIndex].LoadFromFile(Label3.Caption);
  { here's where we add the next item text and bitmap }
  ListBox1.Items.AddObject(Edit1.Text, bitmaps[bitIndex]);
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
  { load the bitmap into the image control for viewing }
  { get the filename, which we will use later to load a copy }
  { of the bitmap into memory again }
  { we must have the height of the most recently loaded bitmap }
  { it's stored in the form-level variable loadedHt }
  if OpenDialog1.Execute then begin
    label3.Caption := OpenDialog1.FileName;
    Image1.Picture.LoadFromFile(OpenDialog1.FileName);
    Label1.Caption := IntToStr(Image1.Picture.Height) + 'x' + IntToStr(Image1.Picture.Width);
    loadedHt := Image1.Picture.Height;
    btnAdd.Enabled := True;
  end;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  bitmap : TBitmap;
  alist: TListBox;
begin
  { type-cast the Control object }
  alist := Control as TListBox;
  { get the bitmap from the TStringList object storage }
  bitmap := TBitmap(alist.Items.Objects[Index]);
  { erase the current rectangle -- this MUST be done or you get garbage}
  { from previous drawing, trust me...}
  alist.Canvas.FillRect(Rect);
  { draw the bitmap }
  alist.Canvas.Draw(Rect.Left, Rect.Top + BORDER, bitmap);
  { draw the text }
  alist.Canvas.TextOut(Rect.Left + bitmap.Width + BORDER, Rect.Top + BORDER,
                       alist.Items[Index]);
end;
 

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
  bitmap : TBitmap;
  alist: TListBox;
begin
  { type-cast the Control object }
  alist := Control as TListBox;
  { get the bitmap from the TStringList object storage }
  bitmap := TBitmap(alist.Items.Objects[Index]);
  { If there is no bitmap, it's because Windows is sizing  }
  { the area before we've finished loading the bitmap..    }
  { in that case, we know the size of the currently loaded }
  { bitmap which must be correct. Otherwise, use the       }
  { bitmap info from the object itself }
  { NOTE: I have noticed that this routine is NEVER called }
  { by Delphi after the initial load, so technically the }
  { ELSE clause never occurs! }
  if bitmap = nil then begin
    if loadedHt >= Height then Height := loadedHt + (BORDER * 2);
    end
  else begin
    if bitmap.Height >= Height then Height := bitmap.Height + (BORDER * 2);
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { just add the horizontal scroll bar so we can see stuff }
  { you might want to size this based on the WIDTH of the }
  { images inserted into the list, I made it an arbitrary fixed size }
  SendMessage(Listbox1.Handle, LB_SETHORIZONTALEXTENT, 1000, Longint(0));
end;

end.