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的显示效果。

　　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下调试通过。

标签：