module1.bas

带声音效果的按钮

Attribute VB_Name = "Module1"
Public Const WM_USER = &H400
Public Const TB_SETSTYLE = WM_USER + 56
Public Const TB_GETSTYLE = WM_USER + 57
Public Const TBSTYLE_FLAT = &H800
Public 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，欲搜索的类名。零表示忽略
Public 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


Public Sub SetToolbar(tBar As Toolbar, tBarStyle As Long)
    Dim lngStyle As Long
    Dim lngResult As Long
    Dim lngHWND As Long

    '得到Toolbar的句柄
    lngHWND = FindWindowEx(tBar.hwnd, 0&, _
        "ToolbarWindow32", vbNullString)
    '得到原有的Toolbar的样式
    lngStyle = SendMessage(lngHWND, _
        TB_GETSTYLE, 0&, 0&)
    '用一个Case语句给Toolbar赋不同的样式
    Select Case tBarStyle
    Case 1:
        '制作一个图形在上、文字在下的平面工具栏
        lngStyle = lngStyle Or TBSTYLE_FLAT
    Case 2:
        '制作一个图形在左、文字在右的平面工具栏
        lngStyle = lngStyle Or TBSTYLE_FLAT _
            Or TBSTYLE_LIST
      End Select
    
    '用API函数实现工具栏的新样式
    lngResult = SendMessage(lngHWND, _
        TB_SETSTYLE, 0, lngStyle)

    '刷新工具栏
    tBar.Refresh
End Sub