我们发现到从 IE 5.0 以后，IE 的工具栏具有了一个新特性：当 IE 窗口缩小，使得工具栏上的按钮不能完全显示时，工具栏右边会出现一个小按钮（M$ 叫它 Chevron，实际上这是 CoolBar 的新特性），点击后出现一下拉列表，显示出被隐藏的按钮。这大大方便了我们对工具栏的使用。
那我们如何使 Delphi 的 TCoolBar 控件具有这个特性呢？经过我一个通宵的查阅资料（MSDN）、“潜心研究”（啊，谁扔我鸡蛋...），终于做出来了！好东西不敢独吞，拿出来与大家分享。下面就说说怎么具体实现它。（以下代码在 Delphi 6 下完成）
第一步：改造 Delphi 的 TCoolBand 类
建议在进行这步前先备份 ComCtrls.pas 文件。如果将 CoolBar 中某个 Band 的 Style 中加上 RBBS_USECHEVRON 这个值，那么当这个 Band 的宽度小于某个给定的值时它就会显示一个下拉按钮（Chevron）。下面来改 ComCtrls.pas 这个文件来实现这个功能。
在 TCoolBand 的 Published 部分增加两个属性(Property)：
//Modified by Joe Huang property DealWidth: Integer read FDealWidth write SetDealWidth; {用来告诉 Band 当 Band 的宽度小于多少时显示下拉按钮（Chevron）} property UseChevron: Boolean read FUseChevron write SetUseChevron; {用来决定 Band 是否使用这个功能} //End
两个属性的写方法如下：
procedure TCoolBand.SetUseChevron(const Value: Boolean); begin FUseChevron := Value; CoolBar.UpdateBands; end; procedure TCoolBand.SetDealWidth(const Value: Integer); begin FDealWidth := Value; CoolBar.UpdateBands; end;
对 TCoolBand 的改动完成，但有一点要提醒的，这两个属性虽然在 Publish 部分，但在设计期并不能看到（我也不知道是怎么搞的）。所以我们只能在运行期间访问到它们。
第二步：改造 Delphi 的 TCoolBar 控件
在 ComCtrls.pas 中找到 TCoolBar.UpdateItem 方法，先为这个方法加个常数如下：
//Modified by Joe Huang RBBS_USECHEVRON = $00000200; //End
然后在这个方法中找到这一行（第一次出现 fMask := 的地方）：
fMask := RBBIM_STYLE or RBBIM_COLORS or RBBIM_SIZE or RBBIM_BACKGROUND or RBBIM_IMAGE or RBBIM_ID;
在这行下加入下段代码：
//Modified by Joe Huang if (GetComCtlVersion >= ComCtlVersionIE5) and Band.UseChevron then {这个功能只在 IE5 后才有} begin fStyle := fStyle or RBBS_USECHEVRON; if Band.DealWidth > 0 then begin fMask := fMask or RBBIM_IDEALSIZE; cxIdeal := Band.DealWidth; end; end; //End
OK！ TCoolBar改造完成。为 ComCtrls.pas 生成 .dcu 文件，方法：把 ComCtrls.pas 文件拷贝到一个现有工程的目录下，把它加到这个工程中，编译这个工程就会得到它的 .dcu 文件，将个 .dcu 文件覆盖（注意备份） Delphi 原来的，在 Delphi6\Lib 目录下。
第三步：在一工程中具体实现。
打开 Delphi6，新建一工程，在 Form1 上放入 CoolBar1，再在 CoolBar1 上面放入 ToolBar1，CoolBar1 会自动产生一 Band。设置 ToolBar1 的 AutoSize 为 True，Wrapable 为 False 并在其上放入你的按钮。设置 CoolBar1 的 AutoSize 为 True， ShowText 为 False（注意：将这属性置为 False 可以为我提供一个利用 Band.Text 属性定位 Band 的方法。在 CoolBar1 上有多个 Band 时定位 Band 是必须的。你也可以采用你自己的定位方式。），设置放有 ToolBar1 的 Band 的 Text 为 MyToolBand。下面开始写代码。
在 Form1 单元的 uses 后加入 CommCtrl 单元；在 Implementation 部分写两个自定义方法：
{用来取得 ToolBar1 上所有可见按钮的总宽度。
用来为我们前面给 TCoolBand 增加的属性 DealWidth 赋值，
即是当 Band 的宽度小于所有按钮的总宽度时显示下拉按钮（Chevron）。}
function GetTBButtonsWidth(AToolBar: TToolBar): Cardinal;
var
ARect, ButtonRect: TRect;
TBCount, I: Integer;
begin
ARect := Rect(0, 0, 0, 0);
TBCount := AToolBar.Perform(TB_BUTTONCOUNT, 0, 0);
for I := 0 to TBCount - 1 do
begin
AToolBar.Perform(TB_GETITEMRECT, I, Integer(@ButtonRect));
ARect.Right := ARect.Right + (ButtonRect.Right - ButtonRect.Left);
end;
Result := Abs(ARect.Right - ARect.Left);
end;
{用来定位 Band
参数 BandText 为你所要定位 Band 的 Text 属性}
function GetCoolBand(BandText: string; ACoolBar: TCoolBar): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to ACoolBar.Bands.Count - 1 do
begin
if ACoolBar.Bands.Items[I].Text = BandText then
begin
Result := I;
Break;
end;
end;
end;
由于 CoolBar1 上 Band 可以改变位置（当有多个 Band 时），所以我们需要一个变量来存储放有 ToolBar1 的 Band 的当前位置（后面会提到如何捕捉到 Band 的位置变化）。
在 Private 部分定义一变量：
private CoolBandIndex: Integer;
在 Form1 的 OnShow 事件加入如下代码：
CoolBandIndex := GetCoolBand('MyToolBand', CoolBar1); {定位 Band 的位置} CoolBar1.Bands.Items[CoolBandIndex].UseChevron := True; {我们自己加的属性} CoolBar1.Bands.Items[CoolBandIndex].DealWidth := GetTBButtonsWidth(ToolBar1); {我们自己加的属性}
现在大家可以运行一下程序了，然后缩放 Form1 使 ToolBar1 上部分按钮被遮住，看下拉按钮（Chevron）是不是出来了！（什么？没有！赶快检查一下前面各步做得是否正确）
大家可能注意到了一个问题：ToolBar1 上按钮可能被遮住了一半，另一半还显示在外面，能不能使一个按钮一旦部分被遮住后，整个按钮不显示呢？我发现 Delphi7 中的 ToolBar 中多了一个属性 HideClippedButtons，就是干这事的，这个属性只在ME、2000、XP下起作用，但 Delphi6 却没有这个属性。有兴趣的可以参照 Delphi7 改一下，很容易的。
各位注意了，重头戏来了。如何点击这个下拉按钮（Chevron）使被遮住的按钮显示出来呢？还有我们前面提到的当 Band 改变位置时如何能通知我们呢？答案是消息！当我们点击下拉按钮（Chevron）时 CoolBar 会给它的父窗口发送 RBN_CHEVRONPUSHED 消息；当改变 Band 的位置会发送 RBN_LAYOUTCHANGED 消息。实际上这两个消息是附加在 WM_NOTIFY 消息中的。下面我们就来在 Form1 的窗口函数中拦截这两个消息（一般来说 Form1 是 CoolBar1 的父，如果你将 CoolBar1 放在其他容器控件中，则要在相应的窗口函数中拦截，原理相同）。
在 Private 部分定义两个变量及一过程：
private
FClientInstance : TFarProc;
FPrevClientProc : TFarProc;
procedure NewWindowProc(var message:TMessage);
在将 NewWindowProc 这个过程的实现前先在 Form1 的 OnShow 事件中加入代码（这段代码写在 OnShow 中所有代码的前面）：
procedure TForm1.FormShow(Sender: TObject); begin {$Warnings Off} FClientInstance := MakeObjectInstance(NewWindowProc); FPrevClientProc := Pointer(GetWindowLong(Form1.Handle, GWL_WNDPROC)); SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(FClientInstance)); {替换 Form1 的窗口函数} {$Warnings On} {... ...} end;
再在 Form1 上放一 PopupMenu1，设置它的 Alignment 为 paRight。用来显示被遮住的按钮。
窗口函数 NewWindowProc 的实现如下：
procedure TForm1.NewWindowProc(var message: TMessage); type {封装一 TNMREBARCHEVRON 结构。这个结构随 RBN_CHEVRONPUSHED 消息发送。} PNMREBARCHEVRON = ^TNMREBARCHEVRON; TNMREBARCHEVRON = record hdr: TNMHDR; uBand: UINT; wID: UINT; lParam: LPARAM; rc: TRECT; lParamNM: LPARAM ; end; const RBN_CHEVRONPUSHED = RBN_FIRST - 10; var ANMHDR: PNMHDR; ANMREBARCHEVRON: PNMREBARCHEVRON; ScreenRect: TRect; FirstClipButton, I: Integer; AMenuItem: TMenuItem; {这个函数用来得到 ToolBar1 上被遮住按钮中最左边那个的位置（Index）。} function GetFirstClipButton(ACoolBar: TCoolBar; AToolBar: TToolBar): Integer; var ButtonRect: TRect; TBCount, I, TempWidth: Integer; begin Result := -1; TempWidth := 0; TBCount := AToolBar.Perform(TB_BUTTONCOUNT, 0, 0); for I := 0 to TBCount - 1 do begin AToolBar.Perform(TB_GETITEMRECT, I, Integer(@ButtonRect)); TempWidth := TempWidth + (ButtonRect.Right - ButtonRect.Left); if TempWidth > AToolBar.Width then begin Result := I; Break; end; end; end; begin with message do begin if Msg = WM_NOTIFY then begin ANMHDR := PNMHDR(LParam); if ANMHDR.code = RBN_CHEVRONPUSHED then {我们点击了下拉按钮（Chevron）} begin ANMREBARCHEVRON := PNMREBARCHEVRON(LParam); ScreenRect := Rect(ClientToScreen(ANMREBARCHEVRON.rc.TopLeft), ClientToScreen(ANMREBARCHEVRON.rc.BottomRight)); FirstClipButton := GetFirstClipButton(CoolBar1, ToolBar1); {得到 ToolBar1 上被遮住按钮中最左边那个的Index} if FirstClipButton = -1 then Exit; PopupMenu1.Items.Clear; {清空 PopupMenu1 上的所有 MenuItem} PopupMenu1.Images := ToolBar1.Images; for I := FirstClipButton to ToolBar1.ButtonCount - 1 do {将所有被遮住的按钮在 PopupMenu1 上用一个 MenuItem 显示出来} begin AMenuItem := TMenuItem.Create(Self); if (ToolBar1.Buttons[i].Style = tbsSeparator) or (ToolBar1.Buttons[i].Style = tbsDivider) then AMenuItem.Caption := '-' else begin AMenuItem.Caption := ToolBar1.Buttons[i].Caption; AMenuItem.ImageIndex := ToolBar1.Buttons[i].ImageIndex; AMenuItem.Enabled := ToolBar1.Buttons[i].Enabled; AMenuItem.OnClick := ToolBar1.Buttons[i].OnClick; if ToolBar1.Buttons[i].Action <> nil then AMenuItem.Action := ToolBar1.Buttons[i].Action; end; PopupMenu1.Items.Add(AMenuItem); end; PopupMenu1.Popup(ScreenRect.Right + 3, ScreenRect.Bottom + 3); end else if ANMHDR.code = RBN_LAYOUTCHANGED then {拦截 Band 位置改变的消息} begin for I := 0 to CoolBar1.Bands.Count - 1 do begin if CoolBar1.Bands.Items[I].Text = 'MyToolBand' then begin CoolBandIndex := I; Break; end; end; end; end; Result := CallWindowProc(FPrevClientProc, Form1.Handle, Msg, wParam, lParam); end; end;
到此，基本代码已经完成（运行看看效果吧，这样的 CoolBar 才有点 Cool 的样子嘛）！
上面的代码还不能完全适用实际的需要，有两点需要特别注意的：
我们看到上面的代码只在 Form1.OnShow 事件中为 DealWidth 赋值： 文章是写完了，就不知道写的是否明了。如有什么疑问，请来 Email 和我讨论，也可向我索要 Demo。
我的 Email: [email protected]
本文地址：http://com.8s8s.com/it/it5513.htm