form1.frm

此源代码可以实现Sync the Status Bar Text with he ToolTip Text

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   3840
      Top             =   1920
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   255
      Left            =   0
      TabIndex        =   1
      Top             =   2940
      Width           =   4680
      _ExtentX        =   8255
      _ExtentY        =   450
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   7752
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Align           =   1  'Align Top
      Height          =   420
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4680
      _ExtentX        =   8255
      _ExtentY        =   741
      ButtonWidth     =   609
      Appearance      =   1
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   2
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "New"
            Object.Tag             =   "Creates a new xxx"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Object.ToolTipText     =   "Open"
            Object.Tag             =   "Opens an existing xxx"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' =========================================
' HOWTO: Sync the StatusBar Text with the ToolTip Text
' Article ID: Q152259
' =========================================

Option Explicit

 'API Declarations
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal pClassName As String, ByVal lpWindowName As String) As Long
 
 Private Declare Function GetWindowText Lib "user32" Alias _
    "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, _
    ByVal cch As Long) As Long

Private Sub Timer1_Timer()

Dim class_name As String
Dim window_handle As Long
Dim window_text As String * 100
Dim window_text_len As Long

Dim tooltip_text As String
Dim button_index As Integer
Dim statusbar_text As String

    'Define the class name.
    class_name = "tooltips_class32"
    'Find and get the window handle.
    window_handle = FindWindow(class_name, vbNullString)

     If window_handle <> 0 Then

        'Get the window text
        window_text_len = GetWindowText(window_handle, window_text, 100)
        tooltip_text = Left$(window_text, window_text_len)

        If tooltip_text = "" Then
            'Mouse not over a Toolbar Button.
            statusbar_text = ""
        Else
            'Iterate through the Buttons collection and find the Button.
            'When found, retrieve text (Button.Tag) for the Statusbar.
            For button_index = 1 To Toolbar1.Buttons.Count
                   If Toolbar1.Buttons(button_index).ToolTipText = _
                    tooltip_text Then

                    statusbar_text = Toolbar1.Buttons(button_index).Tag
                    Exit For
                End If
            Next
        End If

        'Check whether Statusbar already contains this text
        '(without this, the Statusbar will flicker from frequent and
        'unnecessary updates). If it doesn't, update the Statusbar
        'with new text.
        If StatusBar1.Panels(1).Text <> statusbar_text Then
            StatusBar1.Panels(1).Text = statusbar_text
        End If

    End If

End Sub