窗体皮肤实现 - 实现简单Toolbar（六）

自定义皮肤很方便，基础开发的工作也是很大的。不过还好一般产品真正需要开发的并不是很多。现在比较漂亮的界面产品都会有个大大的工具条。

Toolbar工具条实现皮肤的方法还是可以使用Form的处理方案。每当重复写相同东西的时候，有时会感觉无聊。所以想简单实现个轻量级的，依葫芦画瓢进行减肥。

完成后大致的效果

这个简易Toolbar只实现了Button样式，没有分割线没有下拉多选之类的样式。

”这么弱的东西有毛用？“

其实这个工具条主要目的是用于附着在其他控件上使用，比如某些控件的标题区域位置。当然如果想要搞的强大，那么代码量肯定会膨胀。

控件实现内容：

1、加入Hint提示

2、加入了简易动画效果，鼠标进入和离开会有个渐变效果。

实现方案

1、基类选用

2、Action的关联

3、绘制按钮

4、鼠标响应

5、美化（淡入淡出简易动画）

OK～完成

一、基类选择

在基类选择上稍微纠结了下。Delphi大家都知道做一个显示控件一般有2种情况，一种是图形控件（VC里叫静态控件），还种种有焦点可交互的。

如果我想做个Toolbar并不需要焦点，也不需要处理键盘输入，TGraphicControl 是比较理想的继承类。不过最终还是使用了TWinControl，主要一点是TWinControl有个句柄方便处理。当然TGraphicControl也是可以申请句柄的。这个问题就不纠结，确定使用TWinControl。

二、关联Action

说是关联其实就是Toolbar有多少个Button，需要保存这些Button的信息。在标题工具栏(四)中已经有简易实现。个人喜欢用Record来记录东西，简单方便不要管创建和释放。

   TmtToolItem = record
     Action: TBasicAction;
     Enabled: boolean;
     Visible: boolean;
     ImageIndex: Word;         // 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
     Width: Word;              // 实际占用宽度，考虑后续加不同的按钮样式使用
     Fade: Word;               // 褪色量  -
     SaveEvent: TNotifyEvent;  // 原始的Action OnChange事件
   end;

这是一个Button的信息，记录了些基本的信息（这个和原来一样）。如果愿意可以加个样式类型（Style），来绘制更多的Button样式。

   TmtCustomToolbar = class(TWinControl)
   private
     FItems: array of TmtToolItem;
     FCount: Integer;
     ... ...

FItems 和 FCount 用来记录Button的数组容器。直接使用SetLength动态设置数组的长度，简易不用创建直接使用。有了容器，Action就需要个入口来传入。

处理三件事情：

1、检测容器容量，不够增加

2、清空第Count位的Record值（清零）。这步其实对Record比较重要，如果记录中增加参数值时...给你来个随机数那就比较郁闷了。

3、填充记录

4、重算尺寸并重新绘制

 procedure TmtCustomToolbar.Add(Action: TBasicAction; AImageIndex: Integer);
 begin
   if FCount >= Length(FItems) then
     SetLength(FItems, FCount + );

   // 保存Action信息
   ZeroMemory(@FItems[FCount], SizeOf(TmtToolItem));
   FItems[FCount].Action := Action;
   FItems[FCount].Enabled := true;
   FItems[FCount].Visible := true;
   FItems[FCount].ImageIndex := AImageIndex;
   FItems[FCount].Width := ;
   FItems[FCount].Fade := ;
   FItems[FCount].SaveEvent := TacAction(Action).OnChange;
   TacAction(Action).OnChange := DoOnActionChange;

   // 初始化状态
   with FItems[FCount] do
     if Action.InheritsFrom(TContainedAction) then
     begin
       Enabled := TContainedAction(Action).Enabled;
       Visible := TContainedAction(Action).Visible;
     end;

   inc(FCount);

   // 更新显示尺寸
   UpdateSize;
 end;

保存Action信息

三、绘制按钮

绘制肯定是要完全控制，画布画笔都必须牢牢的攥在手里。美与丑就的靠自己有多少艺术细胞。本人是只有艺术脓包，至于你信不信，反正我是信了。

处理两个消息：WM_Paint 和 WM_ERASEBKGND。不让父类（TWinControl）做多余的事情。

WM_ERASEBKGND 处理背景擦除，这个不必处理。直接告诉消息，不处理此消息。

 procedure TmtCustomToolbar.WMEraseBkgnd(var message: TWMEraseBkgnd);
 begin
   Message.Result := ;  // 已经处理完成了，不用再处理
 end;

WM_Paint消息为减少闪烁，使用Buffer进行绘制。

 procedure TmtCustomToolbar.WMPaint(var message: TWMPaint);
 var
   DC, hPaintDC: HDC;
   cBuffer: TBitmap;
   PS: TPaintStruct;
   R: TRect;
   w, h: Integer;
 begin
   ///
   /// 绘制客户区域
   ///
   R := GetClientRect;
   w := R.Width;
   h := R.Height;

   DC := Message.DC;
   hPaintDC := DC;
   if DC =  then
     hPaintDC := BeginPaint(Handle, PS);

   // 创建个画布，在这个上面绘制。
   cBuffer := TBitmap.Create;
   try
     cBuffer.SetSize(w, h);
     PaintBackground(cBuffer.Canvas.Handle);
     PaintWindow(cBuffer.Canvas.Handle);
     // 绘制完成的图形，直接拷贝到界面。这就是传说中的双缓冲技术木？
     BitBlt(hPaintDC, , , w, h, cBuffer.Canvas.Handle, , , SRCCOPY);
   finally
     cBuffer.free;
   end;

   if DC =  then
     EndPaint(Handle, PS);
 end;

最有就是绘制界面上的Action。只要循环绘制完所有按钮就OK了

处理过程：

1、是否要绘制，隐藏跳过

2、根据鼠标事件状态绘制按钮底纹。（按钮在Hot状态还是鼠标按下状态）

3、获得Action的图标，在2的基础上绘制。

OK～完成，偏移位置继续画下个。

获取按钮的状态绘制，默认状态，按下状态和鼠标滑入的状态。

   function GetActionState(Idx: Integer): TSkinIndicator;
   begin
     Result := siInactive;
     if (Idx = FPressedIndex) then
       Result := siPressed
     else if (Idx = FHotIndex) and (FPressedIndex = -) then
       Result := siHover;
   end;

具体绘制色块型的是非常简单，根据不同类型获取状态颜色。

   function GetColor(s: TSkinIndicator): Cardinal; inline;
   begin
     case s of
       siHover         : Result := SKINCOLOR_BTNHOT;
       siPressed       : Result := SKINCOLOR_BTNPRESSED;
       siSelected      : Result := SKINCOLOR_BTNPRESSED;
       siHoverSelected : Result := SKINCOLOR_BTNHOT;
     else                Result := SKINCOLOR_BTNHOT;
     end;
   end;

然后就是直接填充颜色。

  procedure DrawStyle(DC: HDC; const R: TRect; AColor: Cardinal); inline;
  var
    hB: HBRUSH;
  begin
    hB := CreateSolidBrush(AColor);
    FillRect(DC, R, hB);
    DeleteObject(hB);
  end;

 class procedure TTreeViewSkin.DrawButtonState(DC: HDC; AState: TSkinIndicator; const R: TRect; const AOpacity: Byte);

   function GetColor(s: TSkinIndicator): Cardinal; inline;
   begin
     case s of
       siHover         : Result := SKINCOLOR_BTNHOT;
       siPressed       : Result := SKINCOLOR_BTNPRESSED;
       siSelected      : Result := SKINCOLOR_BTNPRESSED;
       siHoverSelected : Result := SKINCOLOR_BTNHOT;
     else                Result := SKINCOLOR_BTNHOT;
     end;
   end;

   procedure DrawStyle(DC: HDC; const R: TRect; AColor: Cardinal); inline;
   var
     hB: HBRUSH;
   begin
     hB := CreateSolidBrush(AColor);
     FillRect(DC, R, hB);
     DeleteObject(hB);
   end;

 var
   cBmp: TBitmap;
 begin
   if AOpacity =  then
       DrawStyle(DC, R, GetColor(AState))
   else if AOpacity >  then
   begin
     cBmp := TBitmap.Create;
     cBmp.SetSize(r.Width, r.Height);
     DrawStyle(cBmp.Canvas.Handle, Rect(, , r.Width, r.Height), GetColor(AState));
     DrawTransparentBitmap(cBmp, , , DC, r.Left, r.Top, r.Width, r.Height, AOpacity);
     cBmp.Free;
   end;
 end;

绘制按钮底纹的完整过程

获得图标就不多说啦。直接根据Action的信息获得。

 function TmtCustomToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;

   function LoadIcon(AImgs: TCustomImageList; AIndex: Integer): boolean;
   begin
     Result := False;
     if Assigned(AImgs) and (AIndex >= ) and (AIndex < AImgs.Count) then
       Result := AImgs.GetBitmap(AIndex, AImg);
   end;

 var
   bHasImg: boolean;
   ImgIdx: Integer;

 begin
   /// 获取Action的图标
   ImgIdx := -;
   AImg.Canvas.Brush.Color := clBlack;
   AImg.Canvas.FillRect(Rect(, , AImg.Width, AImg.Height));
   bHasImg := LoadIcon(FImages, FItems[Idx].ImageIndex);
   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
   begin
     ImgIdx := TCustomAction(FItems[Idx].Action).ImageIndex;
     bHasImg := LoadIcon(TCustomAction(FItems[Idx].Action).Images, ImgIdx);
   end;
   if not bHasImg then
     bHasImg := LoadIcon(FImages, ImgIdx);

   Result := bHasImg;
 end;

获取Action的图标

这里主要注意的是，图标是有透明层。需要使用绘制透明函数AlphaBlend处理。

 class procedure TTreeViewSkin.DrawIcon(DC: HDC; R: TRect; ASrc: TBitmap; const
     Opacity: Byte = );
 var
   iXOff: Integer;
   iYOff: Integer;
 begin
   ///
   ///  绘制图标
   ///    绘制图标是会作居中处理
   iXOff := r.Left + (R.Right - R.Left - ASrc.Width) div ;
   iYOff := r.Top + (r.Bottom - r.Top - ASrc.Height) div ;
   DrawTransparentBitmap(ASrc, , , DC, iXOff, iYOff, ASrc.Width, ASrc.Height, Opacity);
 end;

 procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC;
   const dX, dY: Integer;  w, h: Integer; const Opacity: Byte); overload;
 var
   BlendFunc: TBlendFunction;
 begin
   BlendFunc.BlendOp := AC_SRC_OVER;
   BlendFunc.BlendFlags := ;
   BlendFunc.SourceConstantAlpha := Opacity;

   if Source.PixelFormat = pf32bit then
     BlendFunc.AlphaFormat := AC_SRC_ALPHA
   else
     BlendFunc.AlphaFormat := ;

   AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
 end;

函数：DrawTransparentBitmap

四、鼠标事件响应

鼠标的响应，处理移动、按下、弹起。其他就不需要了。在鼠标移动时检测所在的按钮，按下是一样确定按下的是那个Button，弹开时执行Button的Action事件。不同状态的切换，需要告诉界面进行重新绘制。

在鼠标移动时，除了检测所在按钮外。FHotIndex记录当前光标所在的按钮索引。如果没有按下的状态，需要告诉系统我要显示提示（Hint）。

 procedure TmtCustomToolbar.WMMouseMove(var message: TWMMouseMove);
 var
   iSave: Integer;
 begin
   iSave := FHotIndex;
   HotIndex := HitTest(message.XPos, message.YPos);
   // 在没有按下按钮时触发Hint显示
   if (iSave <> FHotIndex) and (FHotIndex >= ) and  (FPressedIndex = -) then
     Application.ActivateHint(message.Pos);
 end;

按下时检测，按下的那个按钮。FPressedIndex记录按下的按钮索引（就是数组索引）。

 procedure TmtCustomToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
 begin
   if mbLeft = Button then
   begin
     FPressedIndex := HitTest(x, y);
     Invalidate;
   end;
 end;

MouseDown 函数

弹起时处理按钮事件。这里稍微需要处理一下，就是按下鼠标后不松开移动鼠标到其他地方～～ 结果～～。一般系统的处理方式是不执行那个先前被按下的按钮事件。

所以在弹起时也要检测一下。原先按下的和现在的按钮是否一致，不一致就不处理Action。

 procedure TmtCustomToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
 var
   iPressed: Integer;
 begin
   if FPressedIndex >=  then
   begin
     iPressed := HitTest(x, y);
     if iPressed = FPressedIndex then
       ExecAction(iPressed);
   end;
   FPressedIndex := -;
   Invalidate;
 end;

MouseUp 函数

五、美化，加入简易动画效果。

为了能看起来不是很生硬，在进入按钮和离开时增加点动画效果。当然这个还是比较菜的效果。如果想很炫那就的现象一下，如何才能很炫。然后用你手里攥着的画笔涂鸦把！

动画效果主要加入一个90毫秒的一个定时器，90毫秒刷一次界面～。这样就能感觉有点像动画的效果，要更加精细的话可以再短些。

 CONST
   TIMID_FADE = ; // Action褪色

 procedure TmtCustomToolbar.SetHotIndex(const Value: Integer);
 begin
   if FHotIndex <> Value then
   begin
     FHotIndex := Value;
     Invalidate;
     // 鼠标的位置变了，启动定时器
     //   有Handle 就不用再独立创建一个Timer，可以启动很多个用ID区分。
     if not(csDestroying in ComponentState) and HandleAllocated then
       SetTimer(Handle, TIMID_FADE, , nil);
   end;
 end;

到点刷新界面

 procedure TmtCustomToolbar.WMTimer(var message: TWMTimer);
 begin
   // 是褪色定时器，那么刷新界面
   if message.TimerID = TIMID_FADE then
     UpdateFade;
 end;

褪色值其实就是一个0～255的一个透明Alpha通道值，每次绘制底色时根据这个阀值来绘制透明背景Button底纹。所有都为透明时，关闭动画时钟。

 procedure TmtCustomToolbar.UpdateFade;
 var
   I: Integer;
   bHas: boolean;
 begin
   bHas := False;
   for I :=  to FCount -  do
     if FItems[I].Visible and FItems[I].Enabled then
     begin
       // 设置褪色值
       //   鼠标：当前Button，那么趋向不透明（）
       //        不再当前位置，趋向透明（）
       if FHotIndex = I then
         FItems[I].Fade := GetShowAlpha(FItems[I].Fade)
       else if FItems[I].Fade >  then
         FItems[I].Fade := GetFadeAlpha(FItems[I].Fade);
       bHas := bHas or (FItems[I].Fade > );
     end;
   Invalidate;
   if not bHas and HandleAllocated then
     KillTimer(Handle, TIMID_FADE);
 end;

   function GetShowAlpha(v: byte): byte; inline;
   begin
     if v =  then           Result :=
     else if v <=  then   Result :=
     else                    Result := ;
   end;

   function GetFadeAlpha(v: byte): byte; inline;
   begin
     if v >=  then        Result :=
     else if v >=  then   Result :=
     else if v >=  then   Result :=
     else if v >=  then   Result :=
     else if v >=  then    Result :=
     else                    Result := ;
   end;

函数： GetShowAlpha 和 GetFadeAlpha

完成啦～

完整单元代码

 unit uMTToolbars;

 interface

 uses
   Classes, Windows, Messages, Controls, Actions, ImgList, Graphics, ActnList, Forms, Menus, SysUtils;

 type
   TmtToolItem = record
     Action: TBasicAction;
     Enabled: boolean;
     Visible: boolean;
     ImageIndex: Integer;      // 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
     Width: Word;              // 实际占用宽度，考虑后续加不同的按钮样式使用
     Fade: Word;               // 褪色量  -
     SaveEvent: TNotifyEvent;  // 原始的Action OnChange事件
   end;

   TmtCustomToolbar = class(TWinControl)
   private
     FAutoWidth: Boolean;
     FItems: array of TmtToolItem;
     FCount: Integer;
     FImages: TCustomImageList;

     FHotIndex: Integer;
     FPressedIndex: Integer;

     function HitTest(x, y: Integer): Integer;
     procedure ExecAction(Index: Integer);

     procedure DoOnActionChange(Sender: TObject);
     function  LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;
     procedure SetAutoWidth(const Value: Boolean);
     procedure SetHotIndex(const Value: Integer);
     procedure UpdateFade;

     procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
     procedure WMPaint(var message: TWMPaint); message WM_Paint;
     procedure WMMouseLeave(var message: TMessage); message WM_MOUSELEAVE;
     procedure WMMouseMove(var message: TWMMouseMove); message WM_MOUSEMOVE;
     procedure WMTimer(var message: TWMTimer); message WM_TIMER;
     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
     function GetActualWidth: Integer;
   protected
     // 计算实际占用尺寸
     function CalcSize: TRect;
     procedure UpdateSize;

     procedure MouseMove(Shift: TShiftState; x: Integer; y: Integer); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x: Integer; y: Integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x: Integer; y: Integer); override;
     procedure PaintBackground(DC: HDC);
     procedure PaintWindow(DC: HDC); override;

   public
     procedure Add(Action: TBasicAction; AImageIndex: Integer = -);
     function IndexOf(Action: TBasicAction): Integer;

     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;

     property AutoWidth: Boolean read FAutoWidth write SetAutoWidth;
     property HotIndex: Integer read FHotIndex write SetHotIndex;
     property Images: TCustomImageList read FImages write FImages;
     property ActualWidth: Integer read GetActualWidth;

   end;

   TmtToolbar = class(TmtCustomToolbar)
   published
     property Color;
   end;

 implementation

 uses
   uUISkins;

 CONST
   TIMID_FADE = ; // Action褪色

 type
   TacAction = class(TBasicAction);

 procedure TmtCustomToolbar.Add(Action: TBasicAction; AImageIndex: Integer);
 begin
   if FCount >= Length(FItems) then
     SetLength(FItems, FCount + );

   ZeroMemory(@FItems[FCount], SizeOf(TmtToolItem));
   FItems[FCount].Action := Action;
   FItems[FCount].Enabled := true;
   FItems[FCount].Visible := true;
   FItems[FCount].ImageIndex := AImageIndex;
   FItems[FCount].Width := ;
   FItems[FCount].Fade := ;
   FItems[FCount].SaveEvent := TacAction(Action).OnChange;
   TacAction(Action).OnChange := DoOnActionChange;

   // 初始化状态
   with FItems[FCount] do
     if Action.InheritsFrom(TContainedAction) then
     begin
       Enabled := TContainedAction(Action).Enabled;
       Visible := TContainedAction(Action).Visible;
     end;

   inc(FCount);

   UpdateSize;
 end;

 function TmtCustomToolbar.CalcSize: TRect;
 const
   SIZE_SPLITER = ;
   SIZE_POPMENU = ;
   SIZE_BUTTON = ;
 var
   w, h: Integer;
   I: Integer;
 begin
   ///
   /// 占用宽度
   /// 如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。

   // w := SIZE_SPLITER *  + SIZE_POPMENU;
   w := ;
   for I :=  to FCount -  do
     if FItems[i].Visible then
       w := w + FItems[I].Width;
   h := SIZE_BUTTON;
   Result := Rect(, , w, h);
 end;

 procedure TmtCustomToolbar.CMHintShow(var Message: TCMHintShow);
 var
   Idx: Integer;
   sHint: string;
   sTitle, sRemark, sShortCut: string;
 begin
   sTitle := '';
   sRemark := '';
   sShortCut := '';
   Idx := FHotIndex;
   if (Idx >= FCount) or (not FItems[idx].Visible) then
     Idx := -;

   // get hint data
   if Idx >=  then
   begin
     if FItems[Idx].Action.InheritsFrom(TContainedAction) then
       with TContainedAction(FItems[Idx].Action) do
       begin
         sTitle := Caption;
         sRemark := Hint;
         if ShortCut <> scNone then
           sShortCut := ShortCutToText(TCustomAction(Action).ShortCut);
       end;
   end;

   /// format hint string
   if sTitle <> ''  then
   begin
     if sShortCut = '' then
       sHint := sTitle
     else
       sHint := Format('%s（%s）', [sTitle, sShortCut]);

     if (sRemark <> '') and not SameText(sRemark, sTitle) then
       sHint := Format('%s'##'  %s', [sHint, sRemark]);
   end
   else
     sHint := sRemark;

   Message.HintInfo.HintStr := sHint;
   if sHint = '' then
     Message.Result := ;
 end;

 constructor TmtCustomToolbar.Create(AOwner: TComponent);
 begin
   inherited;
   inherited Height := ;
   inherited Width :=  * ;
   FHotIndex := -;
   FPressedIndex := -;
   FAutoWidth := true;
 end;

 destructor TmtCustomToolbar.Destroy;
 begin
   if HandleAllocated  then
     KillTimer(Handle, TIMID_FADE);

   inherited;
 end;

 procedure TmtCustomToolbar.DoOnActionChange(Sender: TObject);
 var
   Idx: Integer;
   bResize: boolean;
 begin
   if Sender is TBasicAction then
   begin
     Idx := IndexOf(TBasicAction(Sender));
     if (Idx >= ) and (Idx < FCount) then
     begin
       ///
       /// 外部状态改变响应
       ///
       if FItems[Idx].Action.InheritsFrom(TContainedAction) then
       begin
         FItems[Idx].Enabled := TContainedAction(Sender).Enabled;
         bResize := FItems[Idx].Visible <> TContainedAction(Sender).Visible;
         if bResize then
         begin
           FItems[Idx].Visible := not FItems[Idx].Visible;
           UpdateSize;
         end
         else if FItems[Idx].Visible then
           Invalidate;
       end;

       /// 执行原有事件
       if Assigned(FItems[Idx].SaveEvent) then
         FItems[Idx].SaveEvent(Sender);
     end;
   end;
 end;

 procedure TmtCustomToolbar.ExecAction(Index: Integer);
 begin
   ///
   /// 执行命令
   ///
   if (Index >= ) and (Index < FCount) then
     FItems[Index].Action.Execute;
 end;

 function TmtCustomToolbar.GetActualWidth: Integer;
 var
   R: TRect;
 begin
   R := CalcSize;
   Result := r.Width;
 end;

 function TmtCustomToolbar.HitTest(x, y: Integer): Integer;
 var
   I: Integer;
   Idx: Integer;
   iOffx: Integer;
 begin
   Idx := -;
   iOffx := ;
   if PtInRect(ClientRect, Point(x, y)) then
     for I :=  to FCount -  do
     begin
       if not FItems[I].Visible then
         Continue;

       iOffx := iOffx + FItems[I].Width;
       if (iOffx > x) then
       begin
         Idx := I;
         Break;
       end;
     end;

   // 去除无效的按钮
   if (Idx >= ) and (not FItems[Idx].Visible or not FItems[Idx].Enabled) then
     Idx := -;

   Result := Idx;
 end;

 function TmtCustomToolbar.IndexOf(Action: TBasicAction): Integer;
 var
   I: Integer;
 begin
   Result := -;
   for I :=  to FCount -  do
     if FItems[I].Action = Action then
     begin
       Result := I;
       Break;
     end;
 end;

 function TmtCustomToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;

   function LoadIcon(AImgs: TCustomImageList; AIndex: Integer): boolean;
   begin
     Result := False;
     if Assigned(AImgs) and (AIndex >= ) and (AIndex < AImgs.Count) then
       Result := AImgs.GetBitmap(AIndex, AImg);
   end;

 var
   bHasImg: boolean;
   ImgIdx: Integer;

 begin
   /// 获取Action的图标
   ImgIdx := -;
   AImg.Canvas.Brush.Color := clBlack;
   AImg.Canvas.FillRect(Rect(, , AImg.Width, AImg.Height));
   bHasImg := LoadIcon(FImages, FItems[Idx].ImageIndex);
   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
   begin
     ImgIdx := TCustomAction(FItems[Idx].Action).ImageIndex;
     bHasImg := LoadIcon(TCustomAction(FItems[Idx].Action).Images, ImgIdx);
   end;
   if not bHasImg then
     bHasImg := LoadIcon(FImages, ImgIdx);

   Result := bHasImg;
 end;

 procedure TmtCustomToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
 begin
   if mbLeft = Button then
   begin
     FPressedIndex := HitTest(x, y);
     Invalidate;
   end;
 end;

 procedure TmtCustomToolbar.MouseMove(Shift: TShiftState; x, y: Integer);
 begin
 end;

 procedure TmtCustomToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
 var
   iPressed: Integer;
 begin
   if FPressedIndex >=  then
   begin
     iPressed := HitTest(x, y);
     if iPressed = FPressedIndex then
       ExecAction(iPressed);
   end;
   FPressedIndex := -;
   Invalidate;
 end;

 procedure TmtCustomToolbar.PaintBackground(DC: HDC);
 var
   hB: HBRUSH;
   R: TRect;
 begin
   R := GetClientRect;
   hB := CreateSolidBrush(ColorToRGB(Color));
   FillRect(DC, R, hB);
   DeleteObject(hB);
 end;

 procedure TmtCustomToolbar.PaintWindow(DC: HDC);
   function GetActionState(Idx: Integer): TSkinIndicator;
   begin
     Result := siInactive;
     if (Idx = FPressedIndex) then
       Result := siPressed
     else if (Idx = FHotIndex) and (FPressedIndex = -) then
       Result := siHover;
   end;

 var
   cIcon: TBitmap;
   R: TRect;
   I: Integer;
   iOpacity: byte;
 begin
   R := Rect(, , , ClientHeight);

   /// 绘制Button
   cIcon := TBitmap.Create;
   cIcon.PixelFormat := pf32bit;
   cIcon.alphaFormat := afIgnored;
   for I :=  to FCount -  do
   begin
     if not FItems[i].Visible then
       Continue;

     R.Right := R.Left + FItems[I].Width;
     if FItems[I].Enabled then
       mtUISkin.DrawButtonState(DC, GetActionState(I), R, FItems[I].Fade);
     if LoadActionIcon(I, cIcon) then
     begin
       iOpacity := ;
       /// 处理不可用状态，图标颜色变暗。
       /// 简易处理，增加绘制透明度。
       if not FItems[I].Enabled then
         iOpacity := ;

       mtUISkin.DrawIcon(DC, R, cIcon, iOpacity);
     end;
     OffsetRect(R, R.Right - R.Left, );
   end;
   cIcon.free;
 end;

 procedure TmtCustomToolbar.SetAutoWidth(const Value: Boolean);
 begin
   if FAutoWidth <> Value then
   begin
     FAutoWidth := Value;
     UpdateSize;
   end;
 end;

 procedure TmtCustomToolbar.SetHotIndex(const Value: Integer);
 begin
   if FHotIndex <> Value then
   begin
     FHotIndex := Value;
     Invalidate;

     if not(csDestroying in ComponentState) and HandleAllocated then
       SetTimer(Handle, TIMID_FADE, , nil);
   end;
 end;

 procedure TmtCustomToolbar.UpdateFade;

   function GetShowAlpha(v: byte): byte; inline;
   begin
     if v =  then           Result :=
     else if v <=  then   Result :=
     else                    Result := ;
   end;

   function GetFadeAlpha(v: byte): byte; inline;
   begin
     if v >=  then        Result :=
     else if v >=  then   Result :=
     else if v >=  then   Result :=
     else if v >=  then   Result :=
     else if v >=  then    Result :=
     else                    Result := ;
   end;

 var
   I: Integer;
   bHas: boolean;
 begin
   bHas := False;
   for I :=  to FCount -  do
     if FItems[I].Visible and FItems[I].Enabled then
     begin
       if FHotIndex = I then
         FItems[I].Fade := GetShowAlpha(FItems[I].Fade)
       else if FItems[I].Fade >  then
         FItems[I].Fade := GetFadeAlpha(FItems[I].Fade);
       bHas := bHas or (FItems[I].Fade > );
     end;
   Invalidate;
   if not bHas and HandleAllocated then
     KillTimer(Handle, TIMID_FADE);
 end;

 procedure TmtCustomToolbar.UpdateSize;
 var
   R: TRect;
 begin
   if FAutoWidth then
   begin
     R := CalcSize;
     SetBounds(Left, Top, R.Width, Height);
   end
   else
     Invalidate;
 end;

 procedure TmtCustomToolbar.WMEraseBkgnd(var message: TWMEraseBkgnd);
 begin
   Message.Result := ;
 end;

 procedure TmtCustomToolbar.WMMouseLeave(var message: TMessage);
 begin
   HotIndex := -;
 end;

 procedure TmtCustomToolbar.WMMouseMove(var message: TWMMouseMove);
 var
   iSave: Integer;
 begin
   iSave := FHotIndex;
   HotIndex := HitTest(message.XPos, message.YPos);
   if (iSave <> FHotIndex) and (FHotIndex >= ) and  (FPressedIndex = -) then
     Application.ActivateHint(message.Pos);
 end;

 procedure TmtCustomToolbar.WMPaint(var message: TWMPaint);
 var
   DC, hPaintDC: HDC;
   cBuffer: TBitmap;
   PS: TPaintStruct;
   R: TRect;
   w, h: Integer;
 begin
   ///
   /// 绘制客户区域
   ///
   R := GetClientRect;
   w := R.Width;
   h := R.Height;

   DC := Message.DC;
   hPaintDC := DC;
   if DC =  then
     hPaintDC := BeginPaint(Handle, PS);

   cBuffer := TBitmap.Create;
   try
     cBuffer.SetSize(w, h);
     PaintBackground(cBuffer.Canvas.Handle);
     PaintWindow(cBuffer.Canvas.Handle);
     BitBlt(hPaintDC, , , w, h, cBuffer.Canvas.Handle, , , SRCCOPY);
   finally
     cBuffer.free;
   end;

   if DC =  then
     EndPaint(Handle, PS);
 end;

 procedure TmtCustomToolbar.WMTimer(var message: TWMTimer);
 begin
   if message.TimerID = TIMID_FADE then
     UpdateFade;
 end;

 end.

unit uMTToolbars;

完整工程

https://github.com/cmacro/simple/tree/master/AnimateToolbar

开发环境：

Delphi XE3

Win7

蘑菇房 (moguf.com)