窗體皮膚實現 - 實現簡單Toolbar(六)

自定義皮膚很方便,基礎開發的工做也是很大的。不過還好通常產品真正須要開發的並非不少。如今比較漂亮的界面產品都會有個大大的工具條。html

Toolbar工具條實現皮膚的方法仍是可使用Form的處理方案。每當重複寫相同東西的時候,有時會感受無聊。因此想簡單實現個輕量級的,依葫蘆畫瓢進行減肥。git

 

完成後大體的效果github

這個簡易Toolbar只實現了Button樣式,沒有分割線沒有下拉多選之類的樣式。數組

」這麼弱的東西有毛用?「ide

其實這個工具條主要目的是用於附着在其餘控件上使用,好比某些控件的標題區域位置。固然若是想要搞的強大,那麼代碼量確定會膨脹。函數

 

控件實現內容:

  一、加入Hint提示工具

  二、加入了簡易動畫效果,鼠標進入和離開會有個漸變效果。動畫

 

實現方案

  一、基類選用spa

  二、Action的關聯code

  三、繪製按鈕

  四、鼠標響應

  五、美化(淡入淡出簡易動畫)

  OK~完成

 

1、基類選擇

  在基類選擇上稍微糾結了下。Delphi你們都知道作一個顯示控件通常有2種狀況,一種是圖形控件(VC裏叫靜態控件),還種種有焦點可交互的。

  若是我想作個Toolbar並不須要焦點,也不須要處理鍵盤輸入,TGraphicControl 是比較理想的繼承類。不過最終仍是使用了TWinControl,主要一點是TWinControl有個句柄方便處理。固然TGraphicControl也是能夠申請句柄的。這個問題就不糾結,肯定使用TWinControl。

2、關聯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就須要個入口來傳入。

處理三件事情:

  一、檢測容器容量,不夠增長

  二、清空第Count位的Record值(清零)。這步其實對Record比較重要,若是記錄中增長參數值時...給你來個隨機數那就比較鬱悶了。

  三、填充記錄

  四、重算尺寸並從新繪製

 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信息

 

3、繪製按鈕

  繪製確定是要徹底控制,畫布畫筆都必須緊緊的攥在手裏。美與醜就的靠本身有多少藝術細胞。本人是隻有藝術膿包,至於你信不信,反正我是信了。

處理兩個消息: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了

處理過程:

   一、是否要繪製,隱藏跳過

   二、根據鼠標事件狀態繪製按鈕底紋。(按鈕在Hot狀態仍是鼠標按下狀態)

   三、得到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

 

4、鼠標事件響應

  鼠標的響應,處理移動、按下、彈起。其餘就不須要了。在鼠標移動時檢測所在的按鈕,按下是同樣肯定按下的是那個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 函數

 

5、美化,加入簡易動畫效果。

  爲了能看起來不是很生硬,在進入按鈕和離開時增長點動畫效果。固然這個仍是比較菜的效果。若是想很炫那就的現象一下,如何才能很炫。而後用你手裏攥着的畫筆塗鴉把!

  動畫效果主要加入一個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,那麼趨向不透明(25512       //        再也不當前位置,趨向透明(013       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)

相關文章
相關標籤/搜索