ToolBar的模样自己画(一)

王朝other·作者佚名  2006-01-09
宽屏版  字体: |||超大  

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

----------------------------------------------------------------

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
© 2005- 王朝网络 版权所有