有研究过 ListBox 自绘可变 item 高度的方法的，请帮忙看看。

Question

本人想利用 ListBox 列出图片+文件说明。图片大小不一，也就要求 ListBox 的每个 item 的高度不同。按以下步骤写好代码：
1，ListBox1 的 Style 属性设为 lbOwnerDrawVariable ；
2，在另外的 Button1 中为 ListBox1 加入数据及图片：procedure TF_ListBoxOwnerDraw.Button1Click(Sender: TObject);
var
  I: integer;
  FilePath, FileName: string;
  MyBmp: TBitmap;
begin
  FilePath := 'E:\Temp\Pic\';
  with ListBox1 do
  begin
    for I := 10 to 30 do
    begin
      FileName := FilePath + 'A0' + IntToStr(I) + '.bmp';
      MyBmp := TBitmap.Create;
      MyBmp.LoadFromFile(FileName);
      Items.AddObject(FileName, TObject(MyBmp));
    end;
  end;
end;3，在 ListBox1 的 OnMeasureItem 事件中写入：procedure TF_ListBoxOwnerDraw.ListBox1MeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
var
  MyPic: TBitmap;
begin
  MyPic := TBitmap((Control as TListBox).Items.Objects[Index]);
  if MyPic <> nil then    //这一句，实际执行时总是得到 nil，不知怎么回事。
    if MyPic.Height <> Height then Height := MyPic.Height;
end;4，在 ListBox 的 OnDrawItem 事件中写入：
procedure TF_ListBoxOwnerDraw.ListBox1DrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  MyPic: TBitmap;
begin
  with Control as TListBox do
  begin
    MyPic := TBitmap(Items.Objects[Index]);
    if odFocused in State then Canvas.Brush.Color := clSkyBlue;
    Canvas.FillRect(Rect);
    Canvas.Draw(Rect.Left + 2, Rect.Top + 2, TGraphic(MyPic));
    Canvas.TextOut(Rect.Left + 2 + 128 + 10, Rect.Top + 2 + 64 - 5, Items[Index]);
  end;
end;执行的结果不正确：所有 item 的高度均为 ListBox1.ItemHeight 中设置的高度，而没有根据实际图片的高度来调整。
经查，是 OnMeasureItem 中，取出图片并将图片高度赋给var Height 参数时，MyPic := TBitmap((Control as TListBox).Items.Objects[Index]); 这一句取出的始终是 nil，
当然就无法得到图片的高度了。现在让我困惑的是，OnMeasureItem 中的代码与 Delphi 帮助中的 Example 一模一样，而且它与在 OnDrawItem 中取得图片的语句也是一样。
在 OnDrawItem 中能够正常取得图片并画到 ListBox1 中，只是 Item 的高度与图片不符。查过很多资料，Delphi 自带的文档中说得很简单，在 CSDN 中也没有查到这种可变高度(lbOwnerDrawVariable) item 的资料，顶多是固定高度 item 的文章。希望大家共同研究。

Answer 1

补充一点：
在 OnMeasureItem 中，
MyPic := TBitmap((Control as TListBox).Items.Objects[Index]); //取出的是 nil，
而如果直接取 item 的字符串则是正常的：
MyStr := (Control as TListBox).Items[Index];  //能够取出正确字符串。

Answer 2

看看....
一、 基础知识　　涉及TListBox自定义重绘的属性和事件：　　属性：　　　Style: 取值为lbStandard(标准风格)，lbOwnerDrawFixed(所有者固定绘制风格)，lbOwnerDrawVariable(所有者可变绘制风格)　　说明：　　　1． 当Style = lbStandard时，使用控件默认的绘制风格。　　　2． 当Style = lbOwnerDrawFixed时，用户只能在控件默认大小的区域绘图。　　　3． 当Style = lbOwnerDrawVariable时，用户可改变控件默认的绘图区域大小并决定如何绘图。　　事件：　　　OnMeasureItem：当Style = lbOwnerDrawVariable时计算TListBox中某项的高度时调用。　　　OnDrawItem ：当Style = lbOwnerDrawVariable时由用户例程确定如何绘制TlistItem。　　由此，可以看出，要实现定制界面风格的TListBox，首先，需要设置TlistBox的Style 属性为lbOwnerDrawVariable，其次，需要写自定义的重绘事件。
　　二、 特殊效果的实现　　在窗体(Form1)上放置5个ListBox，名称分别为ListBox1……ListBox5，将所有ListBox的Style属性设置为lbOwnerDrawVariable；在Form1上添加两个TImageList控件，命名为ImageList1，ImageList2；在ImageList1中装入两个16X16大小的图标；添加两个TButton控件，命名为Button1，Button2；再添加一个TImage控件，命名为Image1。其它操作，见下。　　1． 具有图标及热链接效果的列表框　　在ListBox1的Items属性中添加几个字符串，并在ListBox1的OnDrawItem事件中编写代码如下：
procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
AIcon, BIcon: TIcon;
begin
try
file://从上述ImageList1中装入两个图标
AIcon := TIcon.Create; 
BIcon := TIcon.Create;
file://装入图标到AIcon, BIcon
ImageList1.GetIcon(0, AIcon);
ImageList1.GetIcon(1, BIcon);
file://填充绘图区
ListBox1.Canvas.FillRect(Rect);
file://判断ListBox1中的当前重绘项是否被选中，根据状态装入不同的图标
if odSelected in State then
ListBox1.Canvas.Draw(Rect.Left, Rect.Top, AIcon)
else
ListBox1.Canvas.Draw(Rect.Left, Rect.Top, BIcon);
file://输出文字
ListBox1.Canvas.TextOut(Rect.Left + AIcon.Width div 2, Rect.Top + 2, ListBox1.Items[Index]);
finally
AIcon.Free;
BIcon.Free;
end;
end;
 注：也可在OnMeasureItem事件中改变列表项的高度。　　2． 具有横向滚动条效果的列表框　　在Form1上Button1的Click事件中书写如下代码：procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, ListBox1.Width + 30, 0);
end;
 具体横向滚动区域的宽度可通过具体计算得出，在此从略。　　3． 具有图标，背景图片及透明文字效果的列表框　　说明：　　1． 要使TListBox具有指定位图的背景，须考虑到以下问题：　　如果TListBox的Items足够多，那么，在TListBox的OnDrawItem事件的Rect区域输出位图即可使整个TListBox的Canvas充满位图背景；反之，则会出现TListBox中上半部分有Item的地方有背景，下半部分没有Item的部分仍然为白色，影响视觉效果。　　2． TListBox的Color属性决定了文本输出时的背景，通常为clWindow，这样用TextOut时就会出现不协调的白色文字背景。因此，要实现透明文字输出效果，可以通过设置ListBox.Canvas.Brush.Style := bsClear，这样，绘制的文字没有背景色，从而实现文字透明输出效果。　　操作：　　在ListBox2的Items属性中添加几个字符串；设置Form1上的Image1的Picture属性为一指定图片。在ListBox2的OnDrawItem事件中书写如下代码：procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
AIcon: TIcon;
I, K : Integer;
ARect, BRect: TRect;
H : Integer;
AStyle: TBrushStyle;
begin
try
file://计算Item数量
I := ListBox2.Items.Count-1;
AIcon := TIcon.Create;
file://装入图标
ImageList1.GetIcon(0, AIcon);
file://填充区域
ListBox2.Canvas.FillRect(Rect);
file://计算Rect绘图区的高度
H := Rect.Bottom - Rect.Top;
file://如果当前项是Item的最后一项，则在Canvas上没有Item的空白区绘制背景
if Index = I then
begin
K := 1;
ARect := Rect;
file://如果当前绘图项的底部小于ListBox2的Canvas的底部，有空白区域
While ARect.Bottom <  ListBox2.Canvas.ClipRect.Bottom do
begin
file://一次计算下一个绘图区域
ARect.Top := Rect.Top + K * H;
ARect.Bottom := ARect.Top + H;
ListBox2.Canvas.stretchDraw(ARect, Image1.Picture.Bitmap);
Inc(K);
end;
end;
file://绘制当前项
ListBox2.Canvas.stretchDraw(Rect, Image1.Picture.Bitmap);
file://绘制图标
ListBox2.Canvas.Draw(Rect.Left, Rect.Top, AIcon);
ARect := Rect;
ARect.Left := Rect.Left + AIcon.Width div 2;
ARect.Top := ARect.top + 2;
file://保存当前画笔的风格
AStyle := Listbox2.Canvas.Brush.Style;
file://当前选中的Item要填充蓝色背景
if odSelected in State then
begin
ListBox2.Canvas.Brush.Style := bsSolid;
Listbox2.Canvas.Brush.Color := clBlue;
end
else
begin
file://未选中项透明背景，前景色为黑色
ListBox2.Canvas.Brush.Style := bsClear;
Listbox2.Font.Color := clBlack;
end;
file://输出文字
ListBox2.Canvas.TextOut(ARect.Left, ARect.top, ListBox2.Items[Index]);
file://恢复当前画笔的风格
ListBox2.Canvas.Brush.Style := AStyle;
finally
AIcon.Free;
end;
end;
 　　以上方法实现了TListBox即具有背景图片，又具有图标和透明文字效果，极大的改善了TListBox的显示效果。

Answer 3

4． 具有图标，背景图片，透明文字及文字对齐方式效果的列表框　　要实现文字对齐效果，可通过Windows Api函数：DrawText实现。　　操作：　　将ListBox2的OnDrawItem事件中的代码复制到ListBox3的OnDrawItem事件中，并将复制代码中所有的ListBox2改为ListBox3。　　将上述修改后代码中的ListBox3.Canvas.TextOut(Rect.Left + AIcon.Width div 2, Rect.Top + 2, ListBox3.Items[Index]); 语句删除，并在该处添加以下语句：　　file://计算除掉图标所占区域后的区域，用于确定绘制文字的区域范围ARect := Rect;
ARect.Left := Rect.Left + AIcon.Width div 2;
ARect.Top := ARect.top + 2;
file://Windows Api函数调用
DrawText(ListBox3.Canvas.Handle, PChar(ListBox3.Items[Index]), Length(ListBox3.Items[Index]), ARect, 0); file://0-左对齐， 1---居中， 2--右对齐
 　　注：通知ListBox3重绘可通过命令ListBox3.Refresh实现　　5． 照片列表框效果　　在ListBox4的Items属性中添加几个字符串；设置ImageList2的Width为148，Height为58；在ImageList2中装入与ListBox4中Items相同字符串数量的图片，大小148 X 58像素单位。　　在ListBox4的OnMeasureItem事件中书写如下代码：procedure TForm1.ListBox4MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
file://控制图片的高度
Height := 59;
end;
 　　在ListBox4的OnDrawItem事件中书写如下代码：procedure TForm1.ListBox4DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ABmp: TBitmap;
begin
try
ABmp := TBitmap.Create;
ImageList2.GetBitmap(Index, ABmp);
ListBox4.Canvas.FillRect(Rect);
ListBox4.Canvas.Draw(Rect.Left, Rect.Top, ABmp);
finally
ABmp.Free;
end;
end;
 　　这种利用TListBox实现的照片框效果，对于照片，商品图片的显示有一定价值。　　6． 以缩略图方式浏览某个文件夹下图片效果的列表框　　在ListBox5的OnMeasureItem事件中书写如下代码：procedure TForm1.ListBox5MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
file://控制图片的高度
Height := 59;
end;
 　　在ListBox5的OnDrawItem事件中书写如下代码：procedure TForm1.ListBox5DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
file://图片文件名
Fn: string; 
ABmp: TBitmap;
begin
try
ABmp := TBitmap.Create;
Fn := ListBox5.Items[Index];
ABmp.LoadFromFile(ListBox5.Items[Index]);
Dec(Rect.Bottom);
ListBox5.Canvas.FillRect(Rect);
ListBox5.Canvas.StretchDraw(Rect, ABmp);
finally
ABmp.Free;
end;
end;
 　　设置Button2的Caption为"预览"，在其Click事件中书写如下代码：var
sr: TSearchRec;
Dir: string;
begin
Dir := '';
file://选择目录对话框，需要在Uses中加入对FileCtrl单元的引用声明
if SelectDirectory('选择图片目录', '', Dir) then
begin
ListBox5.Items.Clear;
file://搜索该目录下的所有bmp文件
if FindFirst(Dir + '\*.bmp', faReadOnly, sr) = 0 then
begin
ListBox5.Items.Add(Dir + '\' + Sr.Name);
while FindNext(sr) = 0 do
begin
ListBox5.Items.Add(Dir + '\' + Sr.Name);
end;
FindClose(sr);
end;
end;
end;
 以上六种方法将TBitmap, TIcon, TImage, TImageList结合使用，以及通过Windows API函数极大的改善了TListBox的外观，也为定制修改TlistView, TtreeView等控件的外观提供了参考手段。上述方法在Delphi5下调试通过

Answer 4

谢谢！又复习一遍有关内容。不过，这里面没有我需要的信息。好象我需要的这方面的内容，各种书籍包括 Borland 都是没讲得太深，也许是因为觉得简单。但我的程序就是无法通过。
也许是 Delphi 的一个 BUG 也说不定啊，呵呵。谢谢。

Answer 5

ListBox要处理LB_GETITEMDATA、LB_SETITEMDATA消息，看来是被占用了～～
//参考如下代码～～
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
    FObjects: TList;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
  vBitmap: TBitmap;
begin
  if Index >= FObjects.Count then Exit;
  vBitmap := TBitmap(FObjects[Index]);
  if not Assigned(vBitmap) then Exit;
  if vBitmap.Height = Height then Exit;
  Height := vBitmap.Height;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
  vFileName: string;
  vBitmap: TBitmap;
begin
  FObjects := TList.Create;
  for I := 10 to 30 do
  begin
    vFileName := Format('E:\Temp\Pic\A0%d.bmp', [I]);
    if FileExists(vFileName) then
    begin
      vBitmap := TBitmap.Create;
      vBitmap.LoadFromFile(vFileName);
      vBitmap.Transparent := True;      FObjects.Add(vBitmap);
    end else FObjects.Add(nil);
    ListBox1.AddItem(vFileName, nil);
  end;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
  FObjects.Free;
end;procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  vBitmap: TBitmap;
begin
  with Control as TListBox do
  begin
    vBitmap := TBitmap(FObjects[Index]);
    if odFocused in State then Canvas.Brush.Color := clSkyBlue;
    Canvas.FillRect(Rect);
    Canvas.Draw(Rect.Left, Rect.Top, vBitmap);
    Canvas.Brush.Style := bsClear;
    Canvas.TextOut(Rect.Left + 2,
      Rect.Bottom - Canvas.TextHeight('|') - 1, Items[Index]);
  end;
end;

Answer 6

//补充
procedure TForm1.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to FObjects.Count - 1 do
    if Assigned(FObjects[I]) then
      TObject(FObjects[I]).Free;
  FObjects.Free;
end;

Answer 7

如果说 ListBox 要处理LB_GETITEMDATA、LB_SETITEMDATA消息被占用了，那么 OnDrawItem 是紧接着 OnMeasureItem 执行的，却又为什么能正常取到图片呢？zswang(伴水清清)兄的方法还没有去试，我认为是没问题的，也就是把图片这个“TObject”用另外的 TList 装下，而不与 ListBox 的 item 关联。我也曾试过在 OnMeasure 中直接用 TBitmap.LoadFromFile 装载图片得到图片高度，再赋值给 var Height 变量，结果显示正确，说明 OnMeasureItem 的消息处理是正确的。虽然有办法绕过这个问题，但我总觉得 Delphi 中的方法是最直接最有效的，所以还是想把这个问题弄明白。顺便说一句，看了zswang(伴水清清)兄的代码，感觉功力深厚，真是幸会幸会。也感谢你花时间来写程序回贴子，谢谢。

Answer 8

OnMeasureItem的时候 items.objects还没有来得及加入

Answer 9

好象有点眉目了...我查了一下 AddObject() 的源码，结果如下：ListBox1.Item 是 TStrings 类型，以下是这个类型的源码：**************************************************************************
function TStrings.AddObject(const S: string; AObject: TObject): Integer;
begin
  Result := Add(S);    //这句用来加入字符串。
  PutObject(Result, AObject);    //这句用来关联对象。
end;procedure TStrings.PutObject(Index: Integer; AObject: TObject);
begin
end;
**************************************************************************这样看来，在 TStrings.PutObject 中的确什么也没做！我想这也就是为什么在 OnMeasureItem 中能取出字符串，而无法取出图片的原因了。我接着找了一下 TStringList 的方法：**************************************************************************
function TStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
  if not Sorted then
    Result := FCount
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(@SDuplicateString, 0);
      end;
  InsertItem(Result, S, AObject);
end;procedure TStringList.InsertItem(Index: Integer; const S: string; AObject: TObject);
begin
  Changing;
  if FCount = FCapacity then Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(TStringItem));
  with FList^[Index] do
  begin
    Pointer(FString) := nil;
    FObject := AObject;
    FString := S;
  end;
  Inc(FCount);
  Changed;
end;
**************************************************************************
看来这里的做法才是正道。我尝试着改了一下添加 item 的语句：
TStringList(ListBox1.Items).AddObject(FileName, TObject(MyBmp));结果还是不行。太晚了，明天再想办法吧。

Answer 10

忽然又想到，如果执行的是 TStrings.AddObject() 的方法，没有关联上图片对象，那么为什么在 OnDrawItem 中却又可以正确取得图片并绘制出来呢？有点转圈了~~~另外再提一点，在 Delphi 帮助中，关于 OnMeasureItem 的 Example 中，强调了一个前提条件：
The example assumes that a variable owner-draw list box already has bitmaps associated with each of its strings. 
即假设 ListBox1 是已经关联好了图片对象的。再想想......

Answer 11

-_-!!!!!!! 看到哪里去了？～～TStrings是个虚类，要看也得看TListBoxStrings～～procedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index <> -1) and not (ListBox.Style in [lbVirtual, lbVirtualOwnerDraw]) then
    ListBox.SetItemData(Index, LongInt(AObject));
end;function TListBoxStrings.GetObject(Index: Integer): TObject;
begin
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then
    Result := ListBox.DoGetDataObject(Index)
  else
  begin
    Result := TObject(ListBox.GetItemData(Index));
    if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  end;
end;

Answer 12

关注中不过我自己的做法可能是使用TScrollBar，动态增加TLabel和TImage实现列表功能

Answer 13

//first call
function TListBoxStrings.Add(const S: string): Integer;
begin
  Result := -1;
  if ListBox.Style in [lbVirtual, lbVirtualOwnerDraw] then exit;
  Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, Longint(PChar(S)));
  if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
end;
//next callprocedure TListBoxStrings.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index <> -1) and not (ListBox.Style in [lbVirtual, lbVirtualOwnerDraw]) then
    ListBox.SetItemData(Index, LongInt(AObject));
end;很明显add(s) 的时候已触发OnMeasureItem

Answer 14

因为我只是简单地在 Delphi 帮助中查看了 TListBox.Item 的类型为 TStrings，所以才没找到正路，呵呵。我也知道 TStrings 是个虚类，可一时也没找到有谁覆盖了它的方法...TStringList 只不过是自己比较熟悉的一个子类（现在知道了，跟它没关系^^）。我重新查看了 TListBox 的类定义，发现其没有覆盖祖先的 Creat 方法，它使用的是 TCustomListBox.Create。而在 TCustomListBox.Create 中果然找到了  
  FItems := TListBoxStrings.Create;
  TListBoxStrings(FItems).ListBox := Self;
的语句。再看 TListBoxStrings 的定义，它继承自 TStrings，里面的确覆盖了 TStrings 的 Add() 和 PutObject() 方法：
function Add(const S: string): Integer; override;
procedure PutObject(Index: Integer; AObject: TObject); override;这一下，就很清晰了，如 zjqyb 所说，在 Add(s) 时，就已经触发了 OnMeasureItem ，此时 PutObject() 还未执行。感谢回复的两位高手。不过也请不要烦我以上的“总结”，因为我看到还有人在关注，而且总结一下对自己有好处。那么，接下来，我还是想提出一个问题：针对这种情况，有没有可能找到方法来实现我最初写的程序那样的自绘方法呢？难道只能把图片关联到别的 TList 中吗？（不甘心...）呵呵，谢谢！

Answer 15

基本只能自己重写TCustomListBox了!!!