Results 1 to 2 of 2

Thread: [VB6] ThunderMain class

  1. #1

    Thread Starter
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Post [VB6] ThunderMain class

    This is a class that exposes only one property - ThunderMain's hWnd. ThunderMain's hWnd is chiefly useful in subclassing. It obtains that handle in one of two ways - the first is through the GetWindow function and the second is via the EnumThreadWindows/EnumThreadWndProc functions. The self-contained callback procedure was made possible by Merri's Streamlined SelfCallback code snippets. The algorithm for retrieving the handle is based on samples by Karl E. Peterson. A demo project is included in the zip file.
    Attached Files Attached Files
    Last edited by Bonnie West; Dec 11th, 2013 at 10:52 PM. Reason: Reduced zip file size
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

  2. #2

    Thread Starter
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,060

    Arrow clsThunderMainLite.cls

    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.
    Last edited by Bonnie West; Sep 29th, 2014 at 02:54 AM.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width