自定義皮膚很方便,基礎開發的工做也是很大的。不過還好通常產品真正須要開發的並非不少。如今比較漂亮的界面產品都會有個大大的工具條。html
Toolbar工具條實現皮膚的方法仍是可使用Form的處理方案。每當重複寫相同東西的時候,有時會感受無聊。因此想簡單實現個輕量級的,依葫蘆畫瓢進行減肥。git
完成後大體的效果github
這個簡易Toolbar只實現了Button樣式,沒有分割線沒有下拉多選之類的樣式。數組
」這麼弱的東西有毛用?「ide
其實這個工具條主要目的是用於附着在其餘控件上使用,好比某些控件的標題區域位置。固然若是想要搞的強大,那麼代碼量確定會膨脹。函數
一、加入Hint提示工具
二、加入了簡易動畫效果,鼠標進入和離開會有個漸變效果。動畫
一、基類選用spa
二、Action的關聯code
三、繪製按鈕
四、鼠標響應
五、美化(淡入淡出簡易動畫)
OK~完成
在基類選擇上稍微糾結了下。Delphi你們都知道作一個顯示控件通常有2種狀況,一種是圖形控件(VC裏叫靜態控件),還種種有焦點可交互的。
若是我想作個Toolbar並不須要焦點,也不須要處理鍵盤輸入,TGraphicControl 是比較理想的繼承類。不過最終仍是使用了TWinControl,主要一點是TWinControl有個句柄方便處理。固然TGraphicControl也是能夠申請句柄的。這個問題就不糾結,肯定使用TWinControl。
說是關聯其實就是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;
繪製確定是要徹底控制,畫布畫筆都必須緊緊的攥在手裏。美與醜就的靠本身有多少藝術細胞。本人是隻有藝術膿包,至於你信不信,反正我是信了。
處理兩個消息: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;
這裏主要注意的是,圖標是有透明層。須要使用繪製透明函數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;
鼠標的響應,處理移動、按下、彈起。其餘就不須要了。在鼠標移動時檢測所在的按鈕,按下是同樣肯定按下的是那個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;
彈起時處理按鈕事件。這裏稍微須要處理一下,就是按下鼠標後不鬆開移動鼠標到其餘地方~~ 結果~~。通常系統的處理方式是不執行那個先前被按下的按鈕事件。
因此在彈起時也要檢測一下。原先按下的和如今的按鈕是否一致,不一致就不處理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;
爲了能看起來不是很生硬,在進入按鈕和離開時增長點動畫效果。固然這個仍是比較菜的效果。若是想很炫那就的現象一下,如何才能很炫。而後用你手裏攥着的畫筆塗鴉把!
動畫效果主要加入一個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;
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.
https://github.com/cmacro/simple/tree/master/AnimateToolbar
Delphi XE3
Win7