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. |