Private Const GUI_CARETBLINKING  As Long = &H1
Private Const GUI_INMOVESIZE     As Long = &H2
Private Const GUI_INMENUMODE     As Long = &H4
Private Const GUI_SYSTEMMENUMODE As Long = &H8
Private Const GUI_POPUPMENUMODE  As Long = &H10
Private Const GUI_16BITTASK      As Long = &H20 'winver >= 5.01
Private Const LB_SETTABSTOPS As Long = &H192
Private Const WM_GETTEXT As Long = &HD
Private Const WM_GETTEXTLENGTH As Long = &HE

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Type GUITHREADINFO
   cbSize As Long
   flags As Long
   hwndactive As Long
   hwndFocus As Long
   hwndCapture As Long
   hwndMenuOwner As Long
   hwndMoveSize As Long
   hwndcaret As Long
   rcCaret As RECT
End Type

Private Declare Function GetGuiThreadInfo Lib "user32" _
  Alias "GetGUIThreadInfo" (ByVal idThread As _
   Long, lpgui As GUITHREADINFO) As Long

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

Private Declare Function GetWindowTextLength Lib "user32" _
   Alias "GetWindowTextLengthA" _
  (ByVal hwnd As Long) 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 Form_Load()

  'set up list tabstops 
   ReDim TabArray(0 To 0) As Long
   
   TabArray(0) = 107
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 1&, TabArray(0))
   
  'set up timer intervals 
   With Combo1
      .AddItem "100 milliseconds"
      .ItemData(.NewIndex) = 100
      .AddItem "1/2 second"
      .ItemData(.NewIndex) = 500
      .AddItem "1 second"
      .ItemData(.NewIndex) = 1000
      .AddItem "2 seconds"
      .ItemData(.NewIndex) = 2000
      .AddItem "3 seconds"
      .ItemData(.NewIndex) = 3000
      .AddItem "5 seconds"
      .ItemData(.NewIndex) = 5000
      .ListIndex = 2  '1 second
   End With

   Command1.Caption = "Start"
   Command2.Caption = "Done"
   
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

   Timer1.Enabled = False
   
End Sub


Private Sub Combo1_Click()

  'if timer running, this will
  'change its update frequency
   Timer1.Interval = Combo1.ItemData(Combo1.ListIndex)

End Sub


Private Sub Command1_Click()

   Timer1.Interval = Combo1.ItemData(Combo1.ListIndex)
   Timer1.Enabled = True
   
End Sub

Private Sub Command2_Click()

   Unload Me
   
End Sub


Private Sub Timer1_Timer()

  'nuke the list if 250 or more entries
   If List1.ListCount > 250 Then List1.Clear
   
  'update with info from the active window
   Call GetActiveWindowGuiInfo
   
End Sub


Private Sub GetActiveWindowGuiInfo()

   Dim gui As GUITHREADINFO
   Static numcalls As Long
   
  'idThread identifies the thread for which
  'information is to be retrieved. Where the
  'purpose is to monitor a specific form or
  'application, GetWindowThreadProcessId()
  'provides the thread ID required.
  '
  'Conveniently for this demo, when idThread
  'is null, GetGUIThreadInfo returns information
  'for the foreground thread, thus allowing
  'us to move between applications and view
  'the activities therein.
  
  'cbSize must be set before calling
   gui.cbSize = Len(gui)

   If GetGuiThreadInfo(0&, gui) <> 0 Then
   
     'numcalls is just a counter to increment
     'a line in the list to show the code is
     'working when you rest in one window
      numcalls = numcalls + 1
   
      With List1
      
         .AddItem CStr(numcalls)
         
         .AddItem "active window hwnd:" & vbTab & gui.hwndactive
         .AddItem "   active window title:" & vbTab & GetActiveWindowTitle(gui.hwndactive)
         .AddItem "mouse capture hwnd:" & vbTab & gui.hwndCapture
         .AddItem "showing caret hwnd:" & vbTab & gui.hwndcaret
         .AddItem "    caret window text:" & vbTab & GetCaretWindowText(gui.hwndcaret)
         .AddItem "keyboard focus hwnd:" & vbTab & gui.hwndFocus
         .AddItem "active menu owner hwnd:" & vbTab & gui.hwndMenuOwner
         .AddItem "move or size loop hwnd:" & vbTab & gui.hwndMoveSize
   
         .AddItem "caret rect (l/r t/b):" & vbTab & _
                   gui.rcCaret.Left & "/" & _
                   gui.rcCaret.Right & " " & _
                   gui.rcCaret.Top & "/" & _
                   gui.rcCaret.Bottom
   
        'AND the flags to return the
        'possible GUI states
         .AddItem "returned flags:" & vbTab & gui.flags
         
         If gui.flags And GUI_CARETBLINKING Then .AddItem "caret is visible"
         If gui.flags And GUI_INMOVESIZE Then .AddItem "thread is in a move or size loop"
         If gui.flags And GUI_INMENUMODE Then .AddItem "thread is in menu mode"
         If gui.flags And GUI_SYSTEMMENUMODE Then .AddItem "thread is in system menu mode"
         If gui.flags And GUI_POPUPMENUMODE Then .AddItem "thread has active popup menu"
         If gui.flags And GUI_16BITTASK Then .AddItem "thread's app is 16-bits"
         
         'add a blank line and ensure the
         'last-added entry is in view
         .AddItem ""
         .TopIndex = .NewIndex
         
   End With  'with list1

   Else
   
      With List1
         .AddItem "Error " & Err.LastDllError
         .AddItem "Error " & Err.Description
         .AddItem ""
         .TopIndex = .NewIndex
      End With  'with list1
      
   End If
   
End Sub


Private Function GetActiveWindowTitle(ByVal hwndactive As Long) As String

   Dim nLength As Long
   Dim res As Long
   Dim buff As String
   
  'GetWindowText returns the title
  'of the window specified as hwndactive
   If hwndactive <> 0 Then
   
      nLength = GetWindowTextLength(hwndactive)
      
      If nLength <> 0 Then
         
         buff = Space$(nLength + 1)
         
         res = GetWindowText(hwndactive, buff, nLength + 1)
         
         If res <> 0 Then
            GetActiveWindowTitle = Left$(buff, res)
            Exit Function
         End If  'if res
         
      End If  'if nlength
   
   End If  'if hwndactive
   
   GetActiveWindowTitle = "(not available)"
   
End Function


Private Function GetCaretWindowText(ByVal hwndcaret As Long) As String

   Dim nLength As Long
   Dim res As Long
   Dim buff As String
   
  'WM_GETTEXT retrieves the text
  'from edit and rich text controls
   If hwndcaret <> 0 Then
   
      nLength = SendMessage(hwndcaret, WM_GETTEXTLENGTH, 0&, ByVal 0&)
      
      If nLength <> 0 Then
         
         buff = Space$(nLength + 1)
         
         res = SendMessage(hwndcaret, WM_GETTEXT, nLength + 1, ByVal buff)
         
         If res <> 0 Then
            GetCaretWindowText = Left$(buff, res)
            Exit Function
         End If  'if res
         
      End If  'if nlength
   
   End If  'if hwndcaret
   
   GetCaretWindowText = "(not available)"
   
End Function