toolbar.bas

通用样品管理系统是一个商业程序,功能界面都还不错!

Attribute VB_Name = "toolbarmod"

Option Explicit

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 Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
 ByVal wMsg As Long, _
 ByVal wParam As Long, _
 ByVal lParam As Long) As Long
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
'网页的API
Public Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
'播放AVI的API
Public Declare Function mciSendString& Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long)

Public Sub CoolBar(ByVal STB As toolbar)
    Dim Style As Long
    Dim hToolbar As Long
    Dim R As Long
    '获得工具条窗口句柄
    hToolbar = FindWindowEx(STB.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)
    STB.Refresh
End Sub