设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 513|回复: 4
打印 上一主题 下一主题

实现平面工具栏--流行软件的工具栏上的按钮是平的按钮

[复制链接]
跳转到指定楼层
1#
发表于 2002-9-24 17:07:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
'-------------------------------------------
'            实现平面工具栏
'-------------------------------------------
'           洪恩在线 求知无限
'-------------------------------------------
'程序说明:
'流行软件的工具栏上的按钮是平的按钮,当鼠标移过时才
'会突起,这种效果采用贴图的方法实现十分麻烦,而利用
'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
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2002-9-24 19:31:00 | 只看该作者
呵呵,看了您的這些API的介紹,好像又回到了C或C++時代,我鐘的borland C++現在缺無英雄用武之地,不是我不明白,是這個世界變化太快!
3#
 楼主| 发表于 2002-9-24 19:35:00 | 只看该作者
可我渴望变化!!
时代在进步是吗?
api中的确有很多可以学习的,在access中无法作的api可以做!
我希望office公司能够把它加进去,再做一个,可以直接使用插件就可以完成的access!
有哪一天,HG:
你说我们是该下岗,还是上岗!!
?
4#
发表于 2002-9-24 22:18:00 | 只看该作者
我們以不變應萬變,真簡單的也就是最永久不變的。所以我們要回命今提示符時代。
跟著微軟跑,好累呀,今天95,明天96,後天97,後後天98。。。
我們能跑過微軟嗎?
5#
 楼主| 发表于 2002-9-24 22:39:00 | 只看该作者
注意:
現在是2002!!………………
同志!!一定要頂住!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 13:34 , Processed in 0.087586 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表