发掘ListBox的潜力（一）：自动调整横向滚动条宽度

【 tulaoshi.com - 编程语言 】

自动调整横向滚动条宽度

　　网上可以找到很多让Listbox产生横向滚动条的文章，其中的方法基本一样，就是定义一个函数，遍历Items取得最大的TextWidth值，然后发Listbox发消息LB_SETHORIZONTALEXTENT产生横向滚动条。典型例子如下：
　　procedure SetWidth(Sender: TObject);
　　var
　　    i, w: Integer;
　　begin
　　    w := 0;
　　    with ListBox1 do begin
　　        for i:=0 to Items.Count -1 do begin
　　            if Canvas.TextWidth(Items[i])  w then
　　                w := Canvas.TextWidth(Items[i]);
　　        end;
　　        SendMessage(Handle, LB_SETHORIZONTALEXTENT, w+4, 0);
　　    end;
　　end;　　以上代码的确可用而且被广泛使用，但它有一个很大的缺点：效率大低。因为每次在Listbox中追加、插入或删除一个条目时，都要调用此函数重新计算横向滚动条宽度，而遍历所有项目和调用TextWidth都是很是很耗时的操作。如果用户将条目从当前Listbox拖往另一个Listbox，那么用户一个操作将有两个Listbox必须重新计算横向滚动条宽度，当Listbox内容有上百条的时候，你将明显感觉反应迟缓。
　　OK，现在换个思路。
　　当追加或插入新条目时，只要判断新内容的TextWidth是否大于滚动条宽度，如果是调整滚动条宽度即可。那么删除呢？是的，遍历是不可避免的，但并不是每次删除都需要。可以定义一个变量记录Listbox中TextWidth值最大的条目Index，只有删除这个条目时才需要遍历，其它时候完全可以不管它。
　　还有一种情况必须考虑，用户可能会改变屏幕字体，这时也必须重新计算横向滚动条宽度。跟删除操作一样计算原最大条目的新TextWidth值即可。
　　　　如果窗体上有多个Listbox，记录每个Listbox的最大条目也是一件很麻烦的事，所以我把它封装起来，下面给出完整代码：
　　

　　unit kktListBox;

　　{========================================================================
　　  DESIGN BY :  彭国辉
　　  DATE:        2004-12-24
　　  SITE:        http://kacarton.yeah.net/
　　  BLOG:        http://blog.csdn.net/nhconch
　　  EMAIL:       kacarton#sohu.com

　　  文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！
　　=========================================================================}
　　
　　interface

　　uses
　　  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Commctrl;

　　type
　　  TkktListBox = class(TListBox)
　　  private
　　    MaxLenItemIndex: Integer;
　　    FScrollWidth: Integer;
　　    procedure LBAddString(var Message: TMessage); message LB_ADDSTRING;
　　    procedure LBInsertString(var Message: TMessage); message LB_INSERTSTRING;
　　    procedure LBDeleteString(var Message: TMessage); message LB_DELETESTRING;
　　    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
　　    procedure AdjuctScrollWidth(Message: TMessage);
　　    procedure ResetScrollWidth;

　　  protected

　　  public
　　    constructor Create(AOwner: TComponent); override;

　　  end;

　　procedure Register;

　　implementation

　　{ TkktListBox }

　　constructor TkktListBox.Create(AOwner: TComponent);
　　begin
　　  inherited Create(AOwner);
　　  MaxLenItemIndex := -1;
　　  FScrollWidth := 0;
　　end;

　　procedure TkktListBox.LBAddString(var Message: TMessage);
　　begin
　　  inherited;
　　  if Message.Result = LB_ERR then Exit;
　　  AdjuctScrollWidth(Message);
　　end;

　　procedure TkktListBox.LBInsertString(var Message: TMessage);
　　begin
　　  inherited;
　　  if Message.Result = LB_ERR then Exit;
　　  AdjuctScrollWidth(Message);
　　end;

　　procedure TkktListBox.LBDeleteString(var Message: TMessage);
　　begin
　　  inherited;
　　  if Message.Result = LB_ERR then Exit;
　　  if Message.WParam = MaxLenItemIndex then ResetScrollWidth;
　　end;

　　procedure TkktListBox.CMFontChanged(var Message: TMessage);
　　var
　　  sz: SIZE;
　　begin
　　  inherited;
　　  if MaxLenItemIndex = -1 then Exit;
　　  //这里没有使用TextWidth，而是用GetTextExtentPoint32函数，如果你有兴趣的话
　　  //可以跟踪一个TextWidth函数，它最终是调用GetTextExtentPoint32实现的
　　  GetTextExtentPoint32(Canvas.Handle, PChar(Items[MaxLenItemIndex]), Length(Items[MaxLenItemIndex]), sz);
　　  FScrollWidth := sz.cx + 4;
　　  Perform(LB_SETHORIZONTALEXTENT, FScrollWidth, 0);
　　end;

　　procedure TkktListBox.AdjuctScrollWidth(Message: TMessage);
　　var
　　  sz: SIZE;
　　begin
　　  GetTextExtentPoint32(Canvas.Handle, PChar(Message.LParam), StrLen(PChar(Message.LParam)), sz);
　　  if sz.cx + 4  FScrollWidth then begin
　　    FScrollWidth := sz.cx + 4;
　　    Perform(LB_SETHORIZONTALEXTENT, FScrollWidth, 0);
　　    MaxLenItemIndex := Message.Result;
　　  end;
　　end;

　　procedure TkktListBox.ResetScrollWidth;
　　var
　　  i, MaxWidth: Integer;
　　  sz: SIZE;
　　begin
　　  MaxWidth := 0;
　　  i := Items.Count - 1;
　　  MaxLenItemIndex := -1;
　　  while i=0 do begin
　　    sz.cx := 0;
　　    GetTextExtentPoint32(Canvas.Handle, PChar(Items[i]), Length(Items[i]), sz);
　　    if sz.cx + 4  MaxWidth then begin
　　      MaxWidth := sz.cx + 4;
　　      MaxLenItemIndex := i;
　　    end;
　　    Dec(i);
　　  end;
　　  FScrollWidth := MaxWidth;
　　  Perform(LB_SETHORIZONTALEXTENT, FScrollWidth, 0);
　　end;

　　procedure Register;
　　begin
　　  RegisterComponents('Kacarton', [TkktListBox]);
　　end;

　　end.