• 窗体皮肤实现

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

    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来记录东西，简单方便不要管创建和释放。

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

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

    1   TmtCustomToolbar = class(TWinControl)
2   private
3     FItems: array of TmtToolItem;
4     FCount: Integer;
5     ... ...

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

    处理三件事情：

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

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

      3、填充记录

      4、重算尺寸并重新绘制

     1 procedure TmtCustomToolbar.Add(Action: TBasicAction; AImageIndex: Integer);
 2 begin
 3   if FCount >= Length(FItems) then
 4     SetLength(FItems, FCount + 5);
 5 
 6   // 保存Action信息
 7   ZeroMemory(@FItems[FCount], SizeOf(TmtToolItem));
 8   FItems[FCount].Action := Action;
 9   FItems[FCount].Enabled := true;
10   FItems[FCount].Visible := true;
11   FItems[FCount].ImageIndex := AImageIndex;
12   FItems[FCount].Width := 20;
13   FItems[FCount].Fade := 0;
14   FItems[FCount].SaveEvent := TacAction(Action).OnChange;
15   TacAction(Action).OnChange := DoOnActionChange;
16 
17   // 初始化状态
18   with FItems[FCount] do
19     if Action.InheritsFrom(TContainedAction) then
20     begin
21       Enabled := TContainedAction(Action).Enabled;
22       Visible := TContainedAction(Action).Visible;
23     end;
24 
25   inc(FCount);
26 
27   // 更新显示尺寸
28   UpdateSize;    
29 end;
    保存Action信息

    三、绘制按钮

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

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

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

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

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

     1 procedure TmtCustomToolbar.WMPaint(var message: TWMPaint);
 2 var
 3   DC, hPaintDC: HDC;
 4   cBuffer: TBitmap;
 5   PS: TPaintStruct;
 6   R: TRect;
 7   w, h: Integer;
 8 begin
 9   ///
10   /// 绘制客户区域
11   ///
12   R := GetClientRect;
13   w := R.Width;
14   h := R.Height;
15 
16   DC := Message.DC;
17   hPaintDC := DC;
18   if DC = 0 then
19     hPaintDC := BeginPaint(Handle, PS);
20 
21   // 创建个画布，在这个上面绘制。
22   cBuffer := TBitmap.Create;  
23   try
24     cBuffer.SetSize(w, h);
25     PaintBackground(cBuffer.Canvas.Handle);
26     PaintWindow(cBuffer.Canvas.Handle);
27     // 绘制完成的图形，直接拷贝到界面。这就是传说中的双缓冲技术木？
28     BitBlt(hPaintDC, 0, 0, w, h, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
29   finally
30     cBuffer.free;
31   end;
32 
33   if DC = 0 then
34     EndPaint(Handle, PS);
35 end;

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

    处理过程：

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

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

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

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

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

    1   function GetActionState(Idx: Integer): TSkinIndicator;
2   begin
3     Result := siInactive;   
4     if (Idx = FPressedIndex) then
5       Result := siPressed
6     else if (Idx = FHotIndex) and (FPressedIndex = -1) then
7       Result := siHover;
8   end;

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

     1   function GetColor(s: TSkinIndicator): Cardinal; inline;
 2   begin
 3     case s of
 4       siHover         : Result := SKINCOLOR_BTNHOT;
 5       siPressed       : Result := SKINCOLOR_BTNPRESSED;
 6       siSelected      : Result := SKINCOLOR_BTNPRESSED;
 7       siHoverSelected : Result := SKINCOLOR_BTNHOT;
 8     else                Result := SKINCOLOR_BTNHOT;
 9     end;
10   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;
     1 class procedure TTreeViewSkin.DrawButtonState(DC: HDC; AState: TSkinIndicator; const R: TRect; const AOpacity: Byte);
 2 
 3   function GetColor(s: TSkinIndicator): Cardinal; inline;
 4   begin
 5     case s of
 6       siHover         : Result := SKINCOLOR_BTNHOT;
 7       siPressed       : Result := SKINCOLOR_BTNPRESSED;
 8       siSelected      : Result := SKINCOLOR_BTNPRESSED;
 9       siHoverSelected : Result := SKINCOLOR_BTNHOT;
10     else                Result := SKINCOLOR_BTNHOT;
11     end;
12   end;
13 
14   procedure DrawStyle(DC: HDC; const R: TRect; AColor: Cardinal); inline;
15   var
16     hB: HBRUSH;
17   begin
18     hB := CreateSolidBrush(AColor);
19     FillRect(DC, R, hB);
20     DeleteObject(hB);
21   end;
22 
23 var
24   cBmp: TBitmap;
25 begin
26   if AOpacity = 255 then
27       DrawStyle(DC, R, GetColor(AState))
28   else if AOpacity > 0 then
29   begin
30     cBmp := TBitmap.Create;
31     cBmp.SetSize(r.Width, r.Height);
32     DrawStyle(cBmp.Canvas.Handle, Rect(0, 0, r.Width, r.Height), GetColor(AState));
33     DrawTransparentBitmap(cBmp, 0, 0, DC, r.Left, r.Top, r.Width, r.Height, AOpacity);
34     cBmp.Free;
35   end;
36 end;
    绘制按钮底纹的完整过程

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

     1 function TmtCustomToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;
 2 
 3   function LoadIcon(AImgs: TCustomImageList; AIndex: Integer): boolean;
 4   begin
 5     Result := False;
 6     if Assigned(AImgs) and (AIndex >= 0) and (AIndex < AImgs.Count) then
 7       Result := AImgs.GetBitmap(AIndex, AImg);
 8   end;
 9 
10 var
11   bHasImg: boolean;
12   ImgIdx: Integer;
13 
14 begin
15   /// 获取Action的图标
16   ImgIdx := -1;
17   AImg.Canvas.Brush.Color := clBlack;
18   AImg.Canvas.FillRect(Rect(0, 0, AImg.Width, AImg.Height));
19   bHasImg := LoadIcon(FImages, FItems[Idx].ImageIndex);
20   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
21   begin
22     ImgIdx := TCustomAction(FItems[Idx].Action).ImageIndex;
23     bHasImg := LoadIcon(TCustomAction(FItems[Idx].Action).Images, ImgIdx);
24   end;
25   if not bHasImg then
26     bHasImg := LoadIcon(FImages, ImgIdx);
27 
28   Result := bHasImg;
29 end;
    获取Action的图标

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

     1 class procedure TTreeViewSkin.DrawIcon(DC: HDC; R: TRect; ASrc: TBitmap; const
 2     Opacity: Byte = 255);
 3 var
 4   iXOff: Integer;
 5   iYOff: Integer;
 6 begin
 7   ///
 8   ///  绘制图标
 9   ///    绘制图标是会作居中处理
10   iXOff := r.Left + (R.Right - R.Left - ASrc.Width) div 2;
11   iYOff := r.Top + (r.Bottom - r.Top - ASrc.Height) div 2;
12   DrawTransparentBitmap(ASrc, 0, 0, DC, iXOff, iYOff, ASrc.Width, ASrc.Height, Opacity);
13 end;
     1 procedure DrawTransparentBitmap(Source: TBitmap; sx, sy: Integer; Destination: HDC;
 2   const dX, dY: Integer;  w, h: Integer; const Opacity: Byte); overload;
 3 var
 4   BlendFunc: TBlendFunction;
 5 begin
 6   BlendFunc.BlendOp := AC_SRC_OVER;
 7   BlendFunc.BlendFlags := 0;
 8   BlendFunc.SourceConstantAlpha := Opacity;
 9 
10   if Source.PixelFormat = pf32bit then
11     BlendFunc.AlphaFormat := AC_SRC_ALPHA
12   else
13     BlendFunc.AlphaFormat := 0;
14 
15   AlphaBlend(Destination, dX, dY, w, h, Source.Canvas.Handle, sx, sy, w, h, BlendFunc);
16 end;
    函数：DrawTransparentBitmap

    四、鼠标事件响应

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

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

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

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

    1 procedure TmtCustomToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
2 begin
3   if mbLeft = Button then
4   begin
5     FPressedIndex := HitTest(x, y);
6     Invalidate;
7   end;
8 end;
    MouseDown 函数

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

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

     1 procedure TmtCustomToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
 2 var
 3   iPressed: Integer;
 4 begin
 5   if FPressedIndex >= 0 then
 6   begin
 7     iPressed := HitTest(x, y);
 8     if iPressed = FPressedIndex then
 9       ExecAction(iPressed);
10   end;
11   FPressedIndex := -1;
12   Invalidate;
13 end;
    MouseUp 函数

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

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

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

     1 CONST
 2   TIMID_FADE = 1; // Action褪色
 3 
 4 procedure TmtCustomToolbar.SetHotIndex(const Value: Integer);
 5 begin
 6   if FHotIndex <> Value then
 7   begin
 8     FHotIndex := Value;
 9     Invalidate;
10     // 鼠标的位置变了，启动定时器
11     //   有Handle 就不用再独立创建一个Timer，可以启动很多个用ID区分。
12     if not(csDestroying in ComponentState) and HandleAllocated then
13       SetTimer(Handle, TIMID_FADE, 90, nil);
14   end;
15 end;

    到点刷新界面

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

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

     1 procedure TmtCustomToolbar.UpdateFade;
 2 var
 3   I: Integer;
 4   bHas: boolean;
 5 begin
 6   bHas := False;
 7   for I := 0 to FCount - 1 do
 8     if FItems[I].Visible and FItems[I].Enabled then
 9     begin
10       // 设置褪色值
11       //   鼠标：当前Button，那么趋向不透明（255）
12       //        不再当前位置，趋向透明（0）
13       if FHotIndex = I then
14         FItems[I].Fade := GetShowAlpha(FItems[I].Fade)
15       else if FItems[I].Fade > 0 then
16         FItems[I].Fade := GetFadeAlpha(FItems[I].Fade);
17       bHas := bHas or (FItems[I].Fade > 0);
18     end;
19   Invalidate;
20   if not bHas and HandleAllocated then
21     KillTimer(Handle, TIMID_FADE);
22 end;
     1   function GetShowAlpha(v: byte): byte; inline;
 2   begin
 3     if v = 0 then           Result := 180
 4     else if v <= 180 then   Result := 220
 5     else                    Result := 255;
 6   end;
 7 
 8   function GetFadeAlpha(v: byte): byte; inline;
 9   begin
10     if v >= 255 then        Result := 230
11     else if v >= 230 then   Result := 180
12     else if v >= 180 then   Result := 100
13     else if v >= 100 then   Result := 50
14     else if v >= 50 then    Result := 10
15     else                    Result := 0;
16   end;
    函数： GetShowAlpha 和 GetFadeAlpha

    完成啦～

    完整单元代码

      1 unit uMTToolbars;
  2 
  3 interface
  4 
  5 uses
  6   Classes, Windows, Messages, Controls, Actions, ImgList, Graphics, ActnList, Forms, Menus, SysUtils;
  7 
  8 type
  9   TmtToolItem = record
 10     Action: TBasicAction;
 11     Enabled: boolean;
 12     Visible: boolean;
 13     ImageIndex: Integer;      // 考虑到标题功能图标和实际工具栏功能使用不同图标情况，分开图标索引
 14     Width: Word;              // 实际占用宽度，考虑后续加不同的按钮样式使用
 15     Fade: Word;               // 褪色量 0 - 255
 16     SaveEvent: TNotifyEvent;  // 原始的Action OnChange事件
 17   end;
 18 
 19   TmtCustomToolbar = class(TWinControl)
 20   private
 21     FAutoWidth: Boolean;
 22     FItems: array of TmtToolItem;
 23     FCount: Integer;
 24     FImages: TCustomImageList;
 25 
 26     FHotIndex: Integer;
 27     FPressedIndex: Integer;
 28 
 29     function HitTest(x, y: Integer): Integer;
 30     procedure ExecAction(Index: Integer);
 31 
 32     procedure DoOnActionChange(Sender: TObject);
 33     function  LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;
 34     procedure SetAutoWidth(const Value: Boolean);
 35     procedure SetHotIndex(const Value: Integer);
 36     procedure UpdateFade;
 37 
 38     procedure WMEraseBkgnd(var message: TWMEraseBkgnd); message WM_ERASEBKGND;
 39     procedure WMPaint(var message: TWMPaint); message WM_Paint;
 40     procedure WMMouseLeave(var message: TMessage); message WM_MOUSELEAVE;
 41     procedure WMMouseMove(var message: TWMMouseMove); message WM_MOUSEMOVE;
 42     procedure WMTimer(var message: TWMTimer); message WM_TIMER;
 43     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
 44     function GetActualWidth: Integer;
 45   protected
 46     // 计算实际占用尺寸
 47     function CalcSize: TRect;
 48     procedure UpdateSize;
 49 
 50     procedure MouseMove(Shift: TShiftState; x: Integer; y: Integer); override;
 51     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; x: Integer; y: Integer); override;
 52     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x: Integer; y: Integer); override;
 53     procedure PaintBackground(DC: HDC);
 54     procedure PaintWindow(DC: HDC); override;
 55 
 56   public
 57     procedure Add(Action: TBasicAction; AImageIndex: Integer = -1);
 58     function IndexOf(Action: TBasicAction): Integer;
 59 
 60     constructor Create(AOwner: TComponent); override;
 61     destructor Destroy; override;
 62 
 63     property AutoWidth: Boolean read FAutoWidth write SetAutoWidth;
 64     property HotIndex: Integer read FHotIndex write SetHotIndex;
 65     property Images: TCustomImageList read FImages write FImages;
 66     property ActualWidth: Integer read GetActualWidth;
 67 
 68   end;
 69 
 70   TmtToolbar = class(TmtCustomToolbar)
 71   published
 72     property Color;
 73   end;
 74 
 75 
 76 implementation
 77 
 78 uses
 79   uUISkins;
 80 
 81 CONST
 82   TIMID_FADE = 1; // Action褪色
 83 
 84 type
 85   TacAction = class(TBasicAction);
 86 
 87 procedure TmtCustomToolbar.Add(Action: TBasicAction; AImageIndex: Integer);
 88 begin
 89   if FCount >= Length(FItems) then
 90     SetLength(FItems, FCount + 5);
 91 
 92   ZeroMemory(@FItems[FCount], SizeOf(TmtToolItem));
 93   FItems[FCount].Action := Action;
 94   FItems[FCount].Enabled := true;
 95   FItems[FCount].Visible := true;
 96   FItems[FCount].ImageIndex := AImageIndex;
 97   FItems[FCount].Width := 20;
 98   FItems[FCount].Fade := 0;
 99   FItems[FCount].SaveEvent := TacAction(Action).OnChange;
100   TacAction(Action).OnChange := DoOnActionChange;
101 
102   // 初始化状态
103   with FItems[FCount] do
104     if Action.InheritsFrom(TContainedAction) then
105     begin
106       Enabled := TContainedAction(Action).Enabled;
107       Visible := TContainedAction(Action).Visible;
108     end;
109 
110   inc(FCount);
111 
112   UpdateSize;    
113 end;
114 
115 function TmtCustomToolbar.CalcSize: TRect;
116 const
117   SIZE_SPLITER = 10;
118   SIZE_POPMENU = 10;
119   SIZE_BUTTON = 20;
120 var
121   w, h: Integer;
122   I: Integer;
123 begin
124   ///
125   /// 占用宽度
126   /// 如果考虑比较复杂的按钮样式和显示标题等功能，那么需要计算每个按钮实际占用宽度才能获得。
127 
128   // w := SIZE_SPLITER * 2 + SIZE_POPMENU;
129   w := 0;
130   for I := 0 to FCount - 1 do
131     if FItems[i].Visible then
132       w := w + FItems[I].Width;
133   h := SIZE_BUTTON;
134   Result := Rect(0, 0, w, h);
135 end;
136 
137 procedure TmtCustomToolbar.CMHintShow(var Message: TCMHintShow);
138 var
139   Idx: Integer;
140   sHint: string;
141   sTitle, sRemark, sShortCut: string;
142 begin
143   sTitle := '';
144   sRemark := '';
145   sShortCut := '';
146   Idx := FHotIndex;
147   if (Idx >= FCount) or (not FItems[idx].Visible) then
148     Idx := -1;
149 
150   // get hint data
151   if Idx >= 0 then
152   begin
153     if FItems[Idx].Action.InheritsFrom(TContainedAction) then
154       with TContainedAction(FItems[Idx].Action) do
155       begin
156         sTitle := Caption;
157         sRemark := Hint;
158         if ShortCut <> scNone then
159           sShortCut := ShortCutToText(TCustomAction(Action).ShortCut);
160       end;
161   end;
162 
163   /// format hint string
164   if sTitle <> ''  then
165   begin
166     if sShortCut = '' then
167       sHint := sTitle
168     else
169       sHint := Format('%s（%s）', [sTitle, sShortCut]);
170 
171     if (sRemark <> '') and not SameText(sRemark, sTitle) then
172       sHint := Format('%s'#13#10'  %s', [sHint, sRemark]);
173   end
174   else
175     sHint := sRemark;
176 
177   Message.HintInfo.HintStr := sHint;
178   if sHint = '' then
179     Message.Result := 1;
180 end;
181 
182 constructor TmtCustomToolbar.Create(AOwner: TComponent);
183 begin
184   inherited;
185   inherited Height := 20;
186   inherited Width := 20 * 3;
187   FHotIndex := -1;
188   FPressedIndex := -1;
189   FAutoWidth := true;
190 end;
191 
192 destructor TmtCustomToolbar.Destroy;
193 begin
194   if HandleAllocated  then
195     KillTimer(Handle, TIMID_FADE);
196 
197   inherited;
198 end;
199 
200 procedure TmtCustomToolbar.DoOnActionChange(Sender: TObject);
201 var
202   Idx: Integer;
203   bResize: boolean;
204 begin
205   if Sender is TBasicAction then
206   begin
207     Idx := IndexOf(TBasicAction(Sender));
208     if (Idx >= 0) and (Idx < FCount) then
209     begin
210       ///
211       /// 外部状态改变响应
212       ///
213       if FItems[Idx].Action.InheritsFrom(TContainedAction) then
214       begin
215         FItems[Idx].Enabled := TContainedAction(Sender).Enabled;
216         bResize := FItems[Idx].Visible <> TContainedAction(Sender).Visible;
217         if bResize then
218         begin
219           FItems[Idx].Visible := not FItems[Idx].Visible;
220           UpdateSize;
221         end
222         else if FItems[Idx].Visible then
223           Invalidate;
224       end;
225 
226       /// 执行原有事件
227       if Assigned(FItems[Idx].SaveEvent) then
228         FItems[Idx].SaveEvent(Sender);
229     end;
230   end;
231 end;
232 
233 procedure TmtCustomToolbar.ExecAction(Index: Integer);
234 begin
235   ///
236   /// 执行命令
237   ///
238   if (Index >= 0) and (Index < FCount) then
239     FItems[Index].Action.Execute;
240 end;
241 
242 function TmtCustomToolbar.GetActualWidth: Integer;
243 var
244   R: TRect;
245 begin
246   R := CalcSize;
247   Result := r.Width;
248 end;
249 
250 function TmtCustomToolbar.HitTest(x, y: Integer): Integer;
251 var
252   I: Integer;
253   Idx: Integer;
254   iOffx: Integer;
255 begin
256   Idx := -1;
257   iOffx := 0;
258   if PtInRect(ClientRect, Point(x, y)) then
259     for I := 0 to FCount - 1 do
260     begin
261       if not FItems[I].Visible then
262         Continue;
263 
264       iOffx := iOffx + FItems[I].Width;
265       if (iOffx > x) then
266       begin
267         Idx := I;
268         Break;
269       end;
270     end;
271 
272   // 去除无效的按钮
273   if (Idx >= 0) and (not FItems[Idx].Visible or not FItems[Idx].Enabled) then
274     Idx := -1;
275 
276   Result := Idx;
277 end;
278 
279 function TmtCustomToolbar.IndexOf(Action: TBasicAction): Integer;
280 var
281   I: Integer;
282 begin
283   Result := -1;
284   for I := 0 to FCount - 1 do
285     if FItems[I].Action = Action then
286     begin
287       Result := I;
288       Break;
289     end;
290 end;
291 
292 function TmtCustomToolbar.LoadActionIcon(Idx: Integer; AImg: TBitmap): boolean;
293 
294   function LoadIcon(AImgs: TCustomImageList; AIndex: Integer): boolean;
295   begin
296     Result := False;
297     if Assigned(AImgs) and (AIndex >= 0) and (AIndex < AImgs.Count) then
298       Result := AImgs.GetBitmap(AIndex, AImg);
299   end;
300 
301 var
302   bHasImg: boolean;
303   ImgIdx: Integer;
304 
305 begin
306   /// 获取Action的图标
307   ImgIdx := -1;
308   AImg.Canvas.Brush.Color := clBlack;
309   AImg.Canvas.FillRect(Rect(0, 0, AImg.Width, AImg.Height));
310   bHasImg := LoadIcon(FImages, FItems[Idx].ImageIndex);
311   if not bHasImg and (FItems[Idx].Action is TCustomAction) then
312   begin
313     ImgIdx := TCustomAction(FItems[Idx].Action).ImageIndex;
314     bHasImg := LoadIcon(TCustomAction(FItems[Idx].Action).Images, ImgIdx);
315   end;
316   if not bHasImg then
317     bHasImg := LoadIcon(FImages, ImgIdx);
318 
319   Result := bHasImg;
320 end;
321 
322 procedure TmtCustomToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
323 begin
324   if mbLeft = Button then
325   begin
326     FPressedIndex := HitTest(x, y);
327     Invalidate;
328   end;
329 end;
330 
331 procedure TmtCustomToolbar.MouseMove(Shift: TShiftState; x, y: Integer);
332 begin
333 end;
334 
335 procedure TmtCustomToolbar.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Integer);
336 var
337   iPressed: Integer;
338 begin
339   if FPressedIndex >= 0 then
340   begin
341     iPressed := HitTest(x, y);
342     if iPressed = FPressedIndex then
343       ExecAction(iPressed);
344   end;
345   FPressedIndex := -1;
346   Invalidate;
347 end;
348 
349 procedure TmtCustomToolbar.PaintBackground(DC: HDC);
350 var
351   hB: HBRUSH;
352   R: TRect;
353 begin
354   R := GetClientRect;
355   hB := CreateSolidBrush(ColorToRGB(Color));
356   FillRect(DC, R, hB);
357   DeleteObject(hB);
358 end;
359 
360 procedure TmtCustomToolbar.PaintWindow(DC: HDC);
361   function GetActionState(Idx: Integer): TSkinIndicator;
362   begin
363     Result := siInactive;
364     if (Idx = FPressedIndex) then
365       Result := siPressed
366     else if (Idx = FHotIndex) and (FPressedIndex = -1) then
367       Result := siHover;
368   end;
369 
370 var
371   cIcon: TBitmap;
372   R: TRect;
373   I: Integer;
374   iOpacity: byte;
375 begin
376   R := Rect(0, 0, 0, ClientHeight);
377 
378   /// 绘制Button
379   cIcon := TBitmap.Create;
380   cIcon.PixelFormat := pf32bit;
381   cIcon.alphaFormat := afIgnored;
382   for I := 0 to FCount - 1 do
383   begin
384     if not FItems[i].Visible then
385       Continue;
386 
387     R.Right := R.Left + FItems[I].Width;
388     if FItems[I].Enabled then
389       mtUISkin.DrawButtonState(DC, GetActionState(I), R, FItems[I].Fade);
390     if LoadActionIcon(I, cIcon) then
391     begin
392       iOpacity := 255;
393       /// 处理不可用状态，图标颜色变暗。
394       /// 简易处理，增加绘制透明度。
395       if not FItems[I].Enabled then
396         iOpacity := 100;
397 
398       mtUISkin.DrawIcon(DC, R, cIcon, iOpacity);
399     end;
400     OffsetRect(R, R.Right - R.Left, 0);
401   end;
402   cIcon.free;
403 end;
404 
405 procedure TmtCustomToolbar.SetAutoWidth(const Value: Boolean);
406 begin
407   if FAutoWidth <> Value then
408   begin
409     FAutoWidth := Value;
410     UpdateSize;
411   end;
412 end;
413 
414 procedure TmtCustomToolbar.SetHotIndex(const Value: Integer);
415 begin
416   if FHotIndex <> Value then
417   begin
418     FHotIndex := Value;
419     Invalidate;
420     
421     if not(csDestroying in ComponentState) and HandleAllocated then
422       SetTimer(Handle, TIMID_FADE, 90, nil);
423   end;
424 end;
425 
426 procedure TmtCustomToolbar.UpdateFade;
427 
428   function GetShowAlpha(v: byte): byte; inline;
429   begin
430     if v = 0 then           Result := 180
431     else if v <= 180 then   Result := 220
432     else                    Result := 255;
433   end;
434 
435   function GetFadeAlpha(v: byte): byte; inline;
436   begin
437     if v >= 255 then        Result := 230
438     else if v >= 230 then   Result := 180
439     else if v >= 180 then   Result := 100
440     else if v >= 100 then   Result := 50
441     else if v >= 50 then    Result := 10
442     else                    Result := 0;
443   end;
444 
445 var
446   I: Integer;
447   bHas: boolean;
448 begin
449   bHas := False;
450   for I := 0 to FCount - 1 do
451     if FItems[I].Visible and FItems[I].Enabled then
452     begin
453       if FHotIndex = I then
454         FItems[I].Fade := GetShowAlpha(FItems[I].Fade)
455       else if FItems[I].Fade > 0 then
456         FItems[I].Fade := GetFadeAlpha(FItems[I].Fade);
457       bHas := bHas or (FItems[I].Fade > 0);
458     end;
459   Invalidate;
460   if not bHas and HandleAllocated then
461     KillTimer(Handle, TIMID_FADE);
462 end;
463 
464 procedure TmtCustomToolbar.UpdateSize;
465 var
466   R: TRect;
467 begin
468   if FAutoWidth then
469   begin
470     R := CalcSize;
471     SetBounds(Left, Top, R.Width, Height);
472   end
473   else
474     Invalidate;
475 end;
476 
477 procedure TmtCustomToolbar.WMEraseBkgnd(var message: TWMEraseBkgnd);
478 begin
479   Message.Result := 1;
480 end;
481 
482 procedure TmtCustomToolbar.WMMouseLeave(var message: TMessage);
483 begin
484   HotIndex := -1;
485 end;
486 
487 procedure TmtCustomToolbar.WMMouseMove(var message: TWMMouseMove);
488 var
489   iSave: Integer;
490 begin
491   iSave := FHotIndex;
492   HotIndex := HitTest(message.XPos, message.YPos);
493   if (iSave <> FHotIndex) and (FHotIndex >= 0) and  (FPressedIndex = -1) then
494     Application.ActivateHint(message.Pos);
495 end;
496 
497 procedure TmtCustomToolbar.WMPaint(var message: TWMPaint);
498 var
499   DC, hPaintDC: HDC;
500   cBuffer: TBitmap;
501   PS: TPaintStruct;
502   R: TRect;
503   w, h: Integer;
504 begin
505   ///
506   /// 绘制客户区域
507   ///
508   R := GetClientRect;
509   w := R.Width;
510   h := R.Height;
511 
512   DC := Message.DC;
513   hPaintDC := DC;
514   if DC = 0 then
515     hPaintDC := BeginPaint(Handle, PS);
516 
517   cBuffer := TBitmap.Create;
518   try
519     cBuffer.SetSize(w, h);
520     PaintBackground(cBuffer.Canvas.Handle);
521     PaintWindow(cBuffer.Canvas.Handle);
522     BitBlt(hPaintDC, 0, 0, w, h, cBuffer.Canvas.Handle, 0, 0, SRCCOPY);
523   finally
524     cBuffer.free;
525   end;
526 
527   if DC = 0 then
528     EndPaint(Handle, PS);
529 end;
530 
531 procedure TmtCustomToolbar.WMTimer(var message: TWMTimer);
532 begin
533   if message.TimerID = TIMID_FADE then
534     UpdateFade;
535 end;
536 
537 end.
    unit uMTToolbars;

    完整工程

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

    开发环境：

      Delphi XE3

      Win7

    蘑菇房 (moguf.com)
  • 相关阅读:
    .net core webapi发布到linux中
    封装EF，使用仓储模式所遇到的问题
    oracle取分组的前N条数据
    20141124
    搭建discuz论坛（2）
    安装apache mysql 论坛（一）
    L13 DNS
    L10 PUtty+SSH 访问vncviewer
    L12 samba服务器搭建
    L10 数据入站、转发、出站流程
  • 原文地址：https://www.cnblogs.com/gleam/p/3991825.html
Copyright © 2020-2023  润新知