vbAccelerator - Contents of code file: mEnumWindows.bas

Attribute VB_Name = "mEnumWindows"
Option Explicit


Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long,
 ByVal lParam As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As
 Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA"
 (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias
 "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As
 Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
 As Long
Public Declare Function IsIconic Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal
 hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect
 As RECT) As Long
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 Const WM_COMMAND = &H111
Public Const WM_SYSCOMMAND = &H112
Public Const SC_RESTORE = &HF120&

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
 (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Const WS_EX_APPWINDOW = &H40000
Public Const WS_EX_TOOLWINDOW = &H80&
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As
 Long, lpdwProcessId As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Public Const GWL_EXSTYLE = (-20)
Public Const GWL_STYLE = (-16)

Public Const GW_OWNER = 4
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd
 As Long) As Long

Private m_cSink As IEnumWindowsSink

Private Function EnumWindowsProc( _
        ByVal hwnd As Long, _
        ByVal lParam As Long _
    ) As Long
Dim bStop As Boolean
    bStop = False
    m_cSink.EnumWindow hwnd, bStop
    If (bStop) Then
        EnumWindowsProc = 0
    Else
        EnumWindowsProc = 1
    End If
End Function

Public Function EnumerateWindows( _
        ByRef cSink As IEnumWindowsSink _
    ) As Boolean
    If Not (m_cSink Is Nothing) Then Exit Function
    Set m_cSink = cSink
    EnumWindows AddressOf EnumWindowsProc, cSink.Identifier
    Set m_cSink = Nothing
End Function

Public Function WindowTitle(ByVal lHwnd As Long) As String
Dim lLen As Long
Dim sBuf As String

    ' Get the Window Title:
    lLen = GetWindowTextLength(lHwnd)
    If (lLen > 0) Then
        sBuf = String$(lLen + 1, 0)
        lLen = GetWindowText(lHwnd, sBuf, lLen + 1)
        WindowTitle = Left$(sBuf, lLen)
    End If
    
End Function
Public Function ClassName(ByVal lHwnd As Long) As String
Dim lLen As Long
Dim sBuf As String
    lLen = 260
    sBuf = String$(lLen, 0)
    lLen = GetClassName(lHwnd, sBuf, lLen)
    If (lLen <> 0) Then
        ClassName = Left$(sBuf, lLen)
    End If
End Function
Public Sub ActivateWindow(ByVal lHwnd As Long)
   If (IsIconic(lHwnd)) Then
      SendMessageLong lHwnd, WM_SYSCOMMAND, SC_RESTORE, 0
   End If
   BringWindowToTop lHwnd
   SetForegroundWindow lHwnd
End Sub