用API生成平面工具条
相信许多VB爱好者都曾千方百计地想使自己的工具条像Word97中的工具条一样COOL起来。往往我们不得不去借用别人做好的ActiveBar控件,这样先不说自己的程序变得大了,而且说实话那个控件并不好用。笔者在用VC5编程的时候用基类函数SendMessageLong()、FindWindowEx()轻松实现了这种COOL的效果。受此启发在VB5中调用这两个API也实现了同样的效果。下面是源代码:
把以下程序加到您的模块中:
´----------------------
´常量声明
´----------------------
Public Const WM_USER = &H400
´用户自定义消息的起点
Public Const TB_SETSTYLE = WM_USER 56
´设置工具条风格消息
Public Const TB_GETSTYLE = WM_USER 57
´取得工具条风格消息
Public Const TBSTYLE_FLAT = &H800
´使工具条COOL起来
Public Const TBSTYLE_TOOLTTPS = &H100
Public Const TBSTYLE_WRAPABLE = &H200
Public Const TBSTYLE_ALTDRAG = &H400
Public Const TBSTYLE_LIST = &H1000
Public Const TBSTYLE_CUSTOMERASE = &H2000
´-----------------
´API函数声明
´-----------------
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long,
ByVal wMsg As Long,ByVal wParam As Long,ByVal 1Param As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long,
ByVal hWnd2 As Long,ByVal 1psz1 As String,ByVal 1psz2 As String) As Long
´-----------------------
´通用生成平面工具条过程
´入口:工具条的名字
´-----------------------
Public Sub FlatBar(ByVal tb As Toolbar)
Dim style As Long
Dim hToolbar As Long
Dim r As Long
´获的工具条窗口句柄
hToolbar = FindWindowEx(tb.hwnd,0&,"ToolBarWindow32",vbNullString)
´获的当前工具条的风格
style = SendMessageLong(hToolbar,TB_GETSTYLE,0&, 0&)
If style And TBSTYLE_FLAT Then
style = style Xor TBSTYLE_FLAT
Else
style = style or TBSTYLE_FLAT
End If
´设置工具条的平面风格
r=SendMessageLong(hToolbar,TB_SETSTYLE,0, style)
tb.Refresh
End Sub
过程FlatBar()的调用方法:
1 . 在你的窗体上添加Toolbar控件(命名为:myTB)和ImageList控件。按通常的方法一样在ImageList中播入几个图标并和Toolbar绑定建立一个平常的工具条。
2 . 在窗体的Load()事件中调用FlatBar()
Call FlatBar(myTB)
3. 运行,您的工具条一定COOL起来了。