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
----------------------------------------------------------------
|
本类阅读TOP10