Results 1 to 1 of 1

Thread: System Wide Got/Lost Focus (subclassing)

  1. #1

    Thread Starter
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    6,703

    System Wide Got/Lost Focus (subclassing)

    This is just a small example of how one might accomplish system wide GotFocus and LostFocus events in VB6.

    The way it's setup, it's fairly IDE safe. With the Comctl32 subclassing, there are only two cases that crash the IDE: 1) when you click the "End" button when you get a runtime error, and 2) when you use the IDE's "Stop" button while a modal form is showing. If you've got no modal forms, the IDE's stop button is safe.

    Here's the code that must be placed in a BAS module:

    Code:
    
    Option Explicit
    '
    Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
    Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
    '
    Private Declare Function vbaObjSetAddref Lib "msvbvm60.dll" Alias "__vbaObjSetAddref" (ByRef dstObject As Any, ByRef srcObjPtr As Any) As Long
    '
    
    Public Function SubclassForSystemFocus(frm As Form) As Long
        SubclassForSystemFocus = SetWindowSubclass(frm.hWnd, AddressOf ProcForSystemFocus, frm.hWnd, ObjPtr(frm))
    End Function
    
    Public Function UnSubclassForSystemFocus(hWnd As Long) As Long
        UnSubclassForSystemFocus = RemoveWindowSubclass(hWnd, AddressOf ProcForSystemFocus, hWnd)
    End Function
    
    Public Function ProcForSystemFocus(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
        Const WM_DESTROY            As Long = &H2&
        Const WM_SETFOCUS           As Long = &H7&
        Const WM_KILLFOCUS          As Long = &H8&
        '
        Dim frm As VB.Form                              ' Used for our form's temporary "object" reference.
        '
        Select Case uMsg
        Case WM_DESTROY
            UnSubclassForSystemFocus hWnd
        Case WM_SETFOCUS                                ' Did our form just GET the focus?
            On Error Resume Next                        ' This prevents the IDE from crashing if the GotFocusSystemWide procedure doesn't exist.
                vbaObjSetAddref frm, ByVal dwRefData    ' Get an object reference for our form.
                frm.GotFocusSystemWide                  ' Call our form's GotFocusSystemWide event, or let error handling do its thing.
            On Error GoTo 0
        Case WM_KILLFOCUS                               ' Did our form just LOSE the focus?
            On Error Resume Next                        ' This prevents the IDE from crashing if the LostFocusSystemWide procedure doesn't exist.
                vbaObjSetAddref frm, ByVal dwRefData    ' Get an object reference for our form.
                frm.LostFocusSystemWide                 ' Call our form's LostFocusSystemWide event, or let error handling do its thing.
            On Error GoTo 0
        End Select
        ProcForSystemFocus = DefSubclassProc(hWnd, uMsg, wParam, lParam)
    End Function
    
    
    
    And here's a small test for any form:

    Code:
    
    Option Explicit
    
    Private Sub Form_Load()
        SubclassForSystemFocus Me   ' No need to unsubclass, as it's done automatically.
    End Sub
    
    
    
    Public Sub GotFocusSystemWide()
        Debug.Print "I've got the focus."
    
    
        ' DON'T put any other user-interface in here, or you may create a perpetual loop.
        ' You're still basically in the subclass procedure when you're in here.
    
    
    End Sub
    
    Public Sub LostFocusSystemWide()
        Debug.Print "I've lost the focus."
    
    
        ' DON'T put any other user-interface in here, or you may create a perpetual loop.
        ' You're still basically in the subclass procedure when you're in here.
    
    
    End Sub
    
    
    
    Notice that the GotFocusSystemWide/LostFocusSystemWide events must be declared as Public. This is true because of the late-binding of the form object in the subclass procedure.

    -----------

    And hey, if someone wants to rework this with one of the "completely IDE safe" thunks, that'd be absolutely fine with me.
    Last edited by Elroy; Aug 20th, 2021 at 01:05 PM.
    Any software I post in these forums written by me is provided “AS IS” without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. Please understand that I’ve been programming since the mid-1970s and still have some of that code. My contemporary VB6 project is approaching 1,000 modules. In addition, I have a “VB6 random code folder” that is overflowing. I’ve been at this long enough to truly not know with absolute certainty from whence every single line of my code has come, with much of it coming from programmers under my employ who signed intellectual property transfers. I have not deliberately attempted to remove any licenses and/or attributions from any software. If someone finds that I have inadvertently done so, I sincerely apologize, and, upon notice and reasonable proof, will re-attach those licenses and/or attributions. To all, peace and happiness.

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