|
'-------------------------------------------
' 实现平面工具栏
'-------------------------------------------
' 洪恩在线 求知无限
'-------------------------------------------
'程序说明:
'流行软件的工具栏上的按钮是平的按钮,当鼠标移过时才
'会突起,这种效果采用贴图的方法实现十分麻烦,而利用
'API函数实现起来就很方便,快捷。
'实现的基本思路是:用SendMessage函数向工具栏发送设
'置显示风格STYLE的消息来改变工具栏的显示效果。
'-------------------------------------------
Const WM_USER = &H400
Const TB_SETSTYLE = WM_USER + 56
Const TB_GETSTYLE = WM_USER + 57
Const TBSTYLE_FLAT = &H800
Const TBSTYLE_LIST = &H1000
'-------------------------------------------
'【VB声明】
' Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'【说明】
' 在窗口列表中寻找与指定条件相符的第一个子窗口
'【返回值】
' Long,找到的窗口的句柄。如未找到相符窗口,则返回零。会设置GetLastError
'【参数表】
' hWnd1 ---------- Long,在其中查找子的父窗口。如设为零,表示使用桌面窗口(通常说的顶级窗口都被认为是桌面的子窗口,所以也会对它们进行查找)
' hWnd2 ---------- Long,从这个窗口后开始查找。这样便可利用对FindWindowEx的多次调用找到符合条件的所有子窗口。如设为零,表示从第一个子窗口开始搜索
' lpsz1 ---------- String,欲搜索的类名。零表示忽略
' lpsz2 ---------- String,欲搜索的类名。零表示忽略
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
'--------------------------------------------
'【VB声明】
' Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'【说明】
' 调用一个窗口的窗口函数,将一条消息发给那个窗口。除非消息处理完毕,否则该函数不会返回。SendMessageBynum,
' SendMessageByString是该函数的“类型安全”声明形式
'【返回值】
' Long,由具体的消息决定
'【参数表】
' hwnd ----------- Long,要接收消息的那个窗口的句柄
' wMsg ----------- Long,消息的标识符
' wParam --------- Long,具体取决于消息
' lParam --------- Any,具体取决于消息
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, ByVal lParam As Any) As Long
'----------------------------------------------
'设置工具栏为新的样式
Private Sub SetToolbar(tBar As Toolbar)
Dim lngResult As Long
Dim lngHWND As Long
Dim lngStyle As Long
'得到Toolbar的句柄
lngHWND = FindWindowEx(tBar.hwnd, 0&, "ToolbarWindow32", vbNullString)
'得到原有的Toolbar的样式
lngStyle = SendMessage(lngHWND, TB_GETSTYLE, 0&, 0&)
'设置一个图形在上、文字在下的平面工具栏
lngStyle = lngStyle Or TBSTYLE_FLAT
'用API函数实现工具栏的新样式
lngResult = SendMessage(lngHWND, TB_SETSTYLE, 0, lngStyle)
'刷新工具栏
tBar.Refresh
End Sub
Private Sub exitfile_Click()
Unload Me
End Sub
Private Sub Form_Load()
'调用函数改变工具栏
Call SetToolbar(Me.Toolbar1)
End Sub
'-------------------------------------------
' 实现平面工具栏
'-------------------------------------------
' 洪恩在线 求知无限
'-------------------------------------------
'程序说明:
'流行软件的工具栏上的按钮是平的按钮,当鼠标移过时才
'会突起,这种效果采用贴图的方法实现十分麻烦,而利用
'API函数实现起来就很方便,快捷。
'实现的基本思路是:用SendMessage函数向工具栏发送设
'置显示风格STYLE的消息来改变工具栏的显示效果。
'-------------------------------------------
Const WM_USER = &H400
Const TB_SETSTYLE = WM_USER + 56
Const TB_GETSTYLE = WM_USER + 57
Const TBSTYLE_FLAT = &H800
Const TBSTYLE_LIST = &H1000
'-------------------------------------------
'【VB声明】
' Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As |
|