MS的ToolBar是是最容易找到找的工具欄控件了，簡單方便實用，但它的缺點也是明顯的，樣式古板，與這個時代有點不合拍。為解決這個問題，我專門寫了一個類。
其實ToolBar提供了一個CustomDraw功能，MS為你已搭好了ToolBar的框架，只是ToolBar的模樣交給你自己繪，很簡單地，就可以用任意你想要的模樣，使用ToolBar的所有功能，這比自己做ToolBar是不是更容易更方便？
該功能當然是通過消息機制觸發，其核心就是通過WM_NOTIFY消息，這個消息的lParam參數，就是指向一個NMHDR結構的地址，通過NMHDR結構，我們可得知產生消息的hwnd等信息，確定控件類型，並進一步決定整個結構的類型是什麼，進而獲得NMCUSTOMDRAW和NMTBCUSTOMDRAW結構，NMTBCUSTOMDRAW最前面就是NMCUSTOMDRAW，而NMCUSTOMDRAW最前面就是NMHDR，所以一個NMHDR、NMCUSTOMDRAW，NMCUSTOMDRAW實際上都是同一個地址lParam，只是需根據前面信息，最終確定整個結構的長度而已。
WM_LBUTTONDOWN、WM_LBUTTONUP消息本應與本類無關，只是ToolBar中帶菜單的樣式的按鈕，我一時不知如何獲取其Drap消息，所以被迫採用了判斷鼠標動作的權宜之計，不知哪位能把這個改改。
DrawToolbarButton過程是改變按鈕樣式的核心內容，在這部分下下功夫，就可以做出自己理想的ToolBar了
'測試窗體中的代碼：需有個ToolBar，最好有ImageList。
Option Explicit
Private Sub Command1_Click()
Dim i As Long
With oTbr
Randomize
'If .BackPicture = "" Then
' .BackPicture = "e:\12.jpg"
'Else
' .BackPicture = ""
'End If
.BorderColor = vbBlue '只有BorderStyle大於3時才有效
.BackColor = Rnd * (2 ^ 24)
.TextColor = Rnd * (2 ^ 24)
.TextHiColor = Rnd * (2 ^ 24)
i = .BorderStyle + 1
If i > 4 Then i = 0
.BorderStyle = i '取值範圍0-4
End With
End Sub
Private Sub Command2_Click()
If oTbr Is Nothing Then
Set oTbr = New cToolbar
With oTbr
.BindToolBar Toolbar1.hWnd
End With
Command2.Caption = "取消樣式"
Command1.Enabled = True
Else
Set oTbr = Nothing
Toolbar1.Refresh
Command2.Caption = "加載樣式"
Command1.Enabled = False
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "隨機變樣"
Command2.Caption = "加載樣式"
Command2.Enabled = True
Command1.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set oTbr = Nothing
End Sub
--------------------------------------------------
--------------------------------------------------
'標準模塊中的代碼：
Option Explicit
Public oTbr As cToolbar
Public OldWindowProc As Long
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function TBSubClass(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim ProcOK As Long
Static MouseDown As Boolean
If Msg = WM_NOTIFY Then
ProcOK = oTbr.MsgProc(lp, MouseDown)
ElseIf Msg = WM_LBUTTONDOWN Then
MouseDown = True
ElseIf Msg = WM_LBUTTONUP Then
MouseDown = False
End If
If ProcOK Then
TBSubClass = ProcOK
Else
TBSubClass = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
End If
End Function
|