This is a more lightweight version of the previous class.
Code:
'clsThunderMainLite.cls
Option Explicit 'Retrieves the handle of the unseen top-level window in a VB process.
#If False Then
Private Const sThunderMain As String = "ThunderRT5Main" 'VB5
#Else 'Set this accordingly
Private Const sThunderMain As String = "ThunderRT6Main" 'VB6
#End If
Private Const GW_OWNER As Long = 4 'The retrieved handle identifies the specified window's owner window, if any.
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function FindWindowW Lib "user32.dll" (Optional ByVal lpClassName As Long, Optional ByVal lpWindowName As Long) As Long
Private Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal uCmd As Long) As Long
Private Declare Function StringFromGUID2 Lib "ole32.dll" (ByRef rguid As UUID, ByVal lpsz As Long, ByVal cchMax As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function UuidCreate Lib "rpcrt4.dll" (ByRef lpUuid As UUID) As Long
Private m_hWnd As Long
Private Sub Class_Initialize()
Dim sPrevTitle As String
If Forms.Count Then 'If there are any loaded Forms,
m_hWnd = GetWindow(Forms(0&).hWnd, GW_OWNER) 'retrieve ThunderMain's hWnd directly
Exit Sub 'by getting their owner window's handle
End If '(ThunderMain owns all Forms in any project)
With App
sPrevTitle = .Title 'Save ThunderMain's current window text
.Title = CreateGUID 'Change title to a highly unique string
If Not InIDE Then 'The class name differs slightly in & out of IDE
m_hWnd = FindWindowW(StrPtr(sThunderMain), StrPtr(.Title)) 'Search for the window handle,
Else 'specifying the different class names
m_hWnd = FindWindowW(StrPtr("ThunderMain"), StrPtr(.Title)) 'and the new unique window text
End If
.Title = sPrevTitle 'Restore the previous title
End With
End Sub
Public Property Get hWnd() As Long 'Returns ThunderMain's window handle
hWnd = m_hWnd
End Property
Private Function CreateGUID() As String 'Smallest but fastest GUID generator
Const RPC_S_OK = 0&: Dim udtUUID As UUID
If UuidCreate(udtUUID) = RPC_S_OK Then _
SysReAllocStringLen VarPtr(CreateGUID), , 38&: _
StringFromGUID2 udtUUID, StrPtr(CreateGUID), 39&
End Function
Private Function InIDE(Optional ByRef B As Boolean = True) As Boolean 'Very efficient function for testing whether
If B Then Debug.Assert Not InIDE(InIDE) Else B = True 'this code is running in the IDE or compiled
End Function 'Based on the original by Vesa Piittinen
One situation where ThunderMain's hWnd is useful is when assigning a new Alt-Tab window icon to the app†. For example:
Code:
Option Explicit
Private Const ICON_BIG As Long = 1
Private Const ICON_SMALL As Long = 0
Private Const WM_SETICON As Long = &H80
Private Declare Function LoadIconW Lib "user32.dll" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Sub Form_Load()
Dim hIcon As Long
hIcon = LoadIconW(App.hInstance, 101&)
With New clsThunderMainLite 'This sets the icon used
SendMessageW .hWnd, WM_SETICON, ICON_BIG, hIcon 'in the Alt-Tab window and the
SendMessageW .hWnd, WM_SETICON, ICON_SMALL, hIcon 'Applications tab of Task Manager
End With
End Sub
†Worked only in XP; no longer applies to Win 7.