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:
And here's a small test for any form:
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.
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
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
-----------
And hey, if someone wants to rework this with one of the "completely IDE safe" thunks, that'd be absolutely fine with me.