ToolBar的模样自己画（一）

阿杰

1. 
   
2. 'MS的ToolBar是是最容易找到找的工具栏控件了，简单方便实用，但它的缺点也是明显的，样式古板，与这个时代有点不合拍。为解决这个问题，我专门写了一个类。
   
3. '    其实ToolBar提供了一个CustomDraw功能，MS为你已搭好了ToolBar的框架，只是ToolBar的模样交给你自己绘，很简单地，就可以用任意你想要的模样，使用ToolBar的所有功能，这比自己做ToolBar是不是更容易更方便？
   
4. '    该功能当然是通过消息机制触发，其核心就是通过WM_NOTIFY消息，这个消息的lParam参数，就是指向一个NMHDR结构的地址，通过NMHDR结构，我们可得知产生消息的hwnd等信息，确定控件类型，并进一步决定整个结构的类型是什么，进而获得NMCUSTOMDRAW和NMTBCUSTOMDRAW结构，NMTBCUSTOMDRAW最前面就是NMCUSTOMDRAW，而NMCUSTOMDRAW最前面就是NMHDR，所以一个NMHDR、NMCUSTOMDRAW，NMCUSTOMDRAW实际上都是同一个地址lParam，只是需根据前面信息，最终确定整个结构的长度而已。
   
5. '    WM_LBUTTONDOWN、WM_LBUTTONUP消息本应与本类无关，只是ToolBar中带菜单的样式的按钮，我一时不知如何获取其Drap消息，所以被迫采用了判断鼠标动作的权宜之计，不知哪位能把这个改改。
   
6. '
   
7. '    DrawToolbarButton过程是改变按钮样式的核心内容，在这部分下下功夫，就可以做出自己理想的ToolBar了
   
8. '测试窗体中的代码：需有个ToolBar，最好有ImageList。
   
9. Option Explicit
   
10. Private Sub Command1_Click()
    
11. Dim i As Long
    
12.     With oTbr
    
13.         Randomize
    
14.         'If .BackPicture = "" Then
    
15.         '    .BackPicture = "e:\12.jpg"
    
16.         'Else
    
17.         '    .BackPicture = ""
    
18.         'End If
    
19.         .BorderColor = vbBlue  '只有BorderStyle大于3时才有效
    
20.         .BackColor = Rnd * (2 ^ 24)
    
21.         .TextColor = Rnd * (2 ^ 24)
    
22.         .TextHiColor = Rnd * (2 ^ 24)
    
23.         i = .BorderStyle + 1
    
24.         If i > 4 Then i = 0
    
25.         .BorderStyle = i   '取值范围0-4
    
26.     End With
    
27. End Sub
    
28. Private Sub Command2_Click()
    
29.     If oTbr Is Nothing Then
    
30.         Set oTbr = New cToolbar
    
31.         With oTbr
    
32.         .BindToolBar Toolbar1.hWnd
    
33.         End With
    
34.         Command2.Caption = "取消样式"
    
35.         Command1.Enabled = True
    
36.     Else
    
37.         Set oTbr = Nothing
    
38.         Toolbar1.Refresh
    
39.         Command2.Caption = "加载样式"
    
40.         Command1.Enabled = False
    
41.     End If
    
42. End Sub
    
43. 
    
44. Private Sub Form_Load()
    
45.     Command1.Caption = "随机变样"
    
46.     Command2.Caption = "加载样式"
    
47.     Command2.Enabled = True
    
48.     Command1.Enabled = False
    
49. End Sub
    
50. Private Sub Form_Unload(Cancel As Integer)
    
51.     Set oTbr = Nothing
    
52. End Sub
    
53. '标准模块中的代码：
    
54. Option Explicit
    
55. Public oTbr As cToolbar
    
56. Public OldWindowProc As Long
    
57. Private Const WM_NOTIFY As Long = &H4E
    
58. Private Const WM_LBUTTONDOWN = &H201
    
59. Private Const WM_LBUTTONUP = &H202
    
60. 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
    
61. Public Function TBSubClass(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
    
62.     Dim ProcOK As Long
    
63.     Static MouseDown As Boolean
    
64.     If Msg = WM_NOTIFY Then
    
65.         ProcOK = oTbr.MsgProc(lp, MouseDown)
    
66.     ElseIf Msg = WM_LBUTTONDOWN Then
    
67.         MouseDown = True
    
68.     ElseIf Msg = WM_LBUTTONUP Then
    
69.         MouseDown = False
    
70.     End If
    
71.     If ProcOK Then
    
72.         TBSubClass = ProcOK
    
73.     Else
    
74.         TBSubClass = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
    
75.     End If
    
76. End Function
    
77. 
    

复制代码

开源:http://www.newasp.net/tech/net/12899.html