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

|