none
实现平面工具栏 RRS feed

  • 常规讨论

  • 最后发送TB_SETSTYLE消息给Toolbar,设置新的样式:
       lngStyle = lngStyle Or TBSTYLE_FLAT    设置工具栏的新样式
                            用API函数实现工具栏的新样式

       lngResult = SendMessage(lngHWND, TB_SETSTYLE, 0, lngStyle)  

      通过以上的几个步骤,平面的工具栏就实现了,现在我们来运行一下程序,看看鼠标移到工具栏上的效果吧。

      为了学习方便,以下提供了源代码并附详细的中文注释:

    -------------------------------------------
    实现平面工具栏
    -------------------------------------------
    程序说明:
    流行软件的工具栏上的按钮是平的按钮,当鼠标移过时才
    会突起,这种效果采用贴图的方法实现十分麻烦,而利用
    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
    2009年5月27日 8:30