Office中国论坛/Access中国论坛

标题: 实现平面工具栏--流行软件的工具栏上的按钮是平的按钮 [打印本页]

作者: WTM1 时间: 2002-9-24 17:07
标题: 实现平面工具栏--流行软件的工具栏上的按钮是平的按钮
'-------------------------------------------
'          实现平面工具栏
'-------------------------------------------
'          洪恩在线求知无限
'-------------------------------------------
'程序说明：
'流行软件的工具栏上的按钮是平的按钮，当鼠标移过时才
'会突起，这种效果采用贴图的方法实现十分麻烦，而利用
'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

作者: HG 时间: 2002-9-24 19:31
呵呵，看了您的這些API的介紹，好像又回到了C或C＋＋時代,我鐘的borland　C＋＋現在缺無英雄用武之地，不是我不明白，是這個世界變化太快！

作者: WTM1 时间: 2002-9-24 19:35
可我渴望变化！！
时代在进步是吗？
api中的确有很多可以学习的，在access中无法作的api可以做！
我希望office公司能够把它加进去，再做一个，可以直接使用插件就可以完成的access!
有哪一天，HG：
你说我们是该下岗，还是上岗！！
?

作者: HG 时间: 2002-9-24 22:18
我們以不變應萬變，真簡單的也就是最永久不變的。所以我們要回命今提示符時代。
跟著微軟跑，好累呀，今天95,明天96，後天97，後後天98。。。
我們能跑過微軟嗎？

作者: WTM1 时间: 2002-9-24 22:39
注意：
現在是2002！！………………
同志！！一定要頂住！！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)