There are several examples of how to subclass in this CodeBank. However, most go into complexities of how to "protect the IDE".
I'm posting this to provide an example of VB6 subclassing at its simplest, as it often comes up.
A short explanation:
In VB6, subclassing has come to mean "catching/creating events that VB6 doesn't typically catch". In other languages, it has a much richer meaning (involving inheritance). But in VB6, we restrict it to just capturing any/all "events" that go through any hWnd's message pump.
I use the comctl32.dll approach (which is much more robust than the user32.dll (SetWindowLong) approach).
Here are procedures to subclass (as simple as I know how to make them). This must be in a BAS module:
And here's some code for a Form1, for testing:
I'm posting this to provide an example of VB6 subclassing at its simplest, as it often comes up.
A short explanation:
In VB6, subclassing has come to mean "catching/creating events that VB6 doesn't typically catch". In other languages, it has a much richer meaning (involving inheritance). But in VB6, we restrict it to just capturing any/all "events" that go through any hWnd's message pump.
I use the comctl32.dll approach (which is much more robust than the user32.dll (SetWindowLong) approach).
Here are procedures to subclass (as simple as I know how to make them). This must be in a BAS module:
Code:
Option Explicit
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 GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData 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 DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Here are a few places to get the windows message pump constants:
' https://wiki.winehq.org/List_Of_Windows_Messages
' https://www.autoitscript.com/autoit3/docs/appendix/WinMsgCodes.htm
' https://gist.github.com/amgine/2395987
' https://www.autohotkey.com/docs/v2/misc/SendMessageList.htm
' NOTE: So long as you exit your program normally (including within the IDE), this will be IDE safe.
' However, if you use the "Stop" button, or you click "End" on a syntax error, you will crash the IDE.
' There are approaches to make subclassing completely safe for the IDE, but they're more involved.
'
Public Sub SubclassToSeeMessages(hWnd As Long)
SubclassSomeWindow hWnd, AddressOf ToSeeMessages_Proc
Debug.Print "uMsg, wParam, lParam"
End Sub
Private Function ToSeeMessages_Proc(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&
'
' If we monitor for WM_DESTROY, we typically don't have to worry about un-subclassing.
' Although, there are a few rare situations where we do need to explicitly un-subclass.
If uMsg = WM_DESTROY Then
UnSubclassSomeWindow hWnd, AddressOf_ToSeeMessages_Proc, uIdSubclass
ToSeeMessages_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
Exit Function
End If
'
Select Case uMsg ' Just use this to eliminate ones we don't want, as the message pump is quite noisy.
Case 132, 512, 513, 33, 32, 533
Case Else
Debug.Print Format$(uMsg), Format$(wParam), Format$(lParam)
End Select
'
ToSeeMessages_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Private Function AddressOf_ToSeeMessages_Proc() As Long
AddressOf_ToSeeMessages_Proc = ProcedureAddress(AddressOf ToSeeMessages_Proc)
End Function
' ************************************************************
' ************************************************************
' A few private procedures to try and simplify things a bit.
' ************************************************************
' ************************************************************
Private Sub SubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional dwRefData As Long, Optional uIdSubclass As Long)
If uIdSubclass = 0& Then uIdSubclass = hWnd
Call SetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData)
End Sub
Private Sub UnSubclassSomeWindow(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long)
If uIdSubclass = 0& Then uIdSubclass = hWnd
Call RemoveWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass)
End Sub
Private Function GetSubclassRefData(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long) As Long
If uIdSubclass = 0& Then uIdSubclass = hWnd
Call GetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, GetSubclassRefData)
End Function
Private Function IsSubclassed(hWnd As Long, AddressOf_ProcToSubclass As Long, Optional uIdSubclass As Long) As Boolean
Dim dwRefData As Long
If uIdSubclass = 0& Then uIdSubclass = hWnd
IsSubclassed = GetWindowSubclass(hWnd, AddressOf_ProcToSubclass, uIdSubclass, dwRefData) = 1&
End Function
Private Function ProcedureAddress(AddressOf_TheProc As Long) As Long
ProcedureAddress = AddressOf_TheProc
End Function
Code:
Option Explicit
Private Sub Form_Load()
SubclassToSeeMessages Me.hWnd
End Sub