This is an easy *and* somewhat useful subclassing which calls back into the form or user-control or whichever object instance the subclassing originates from. One could half-heartedly claim it is "IDE-safe" as much as the simplest subclassing submission in the Code Bank (which it is not because one cannot debug the callback and/or stop the running poject while a window is subclassed).
An example of being somewhat useful is when for instance you have 20 forms where each has to subclass its respective window but you don't want to duplicate subclassing code 20 times but just want each form to receive a notification call on a distinct method and deal with it's own messages in an encapsulated manner inside this designated method.
Here is the sample Form1 which as an example has its minimum size limited to 500x500 pixels using subclassing
The biggest advantage to using InitSubclassingEasy and TerminateSubclassingEasy functions is that one can seamlessly transition to a real subclasser like the proven IDE-safe MST by replacing Easy with Thunk in their names i.e. InitSubclassingEasy -> InitSubclassingThunk, TerminateSubclassingEasy -> TerminateSubclassingThunk -- in both implementations params and usage remain the same but in MST you don't need redirectors in a separate module because with MST one can author self-contained subclassing user-controls.
cheers,
</wqw>
An example of being somewhat useful is when for instance you have 20 forms where each has to subclass its respective window but you don't want to duplicate subclassing code 20 times but just want each form to receive a notification call on a distinct method and deal with it's own messages in an encapsulated manner inside this designated method.
Code:
'--- mdEasySubclassing.bas
Option Explicit
Private Declare Function SetWindowSubclass Lib "comctl32" 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" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function InitSubclassingEasy(ByVal hWnd As Long, pObj As Object, ByVal pfnCallback As Long) As IUnknown
Dim oCol As Collection
Call SetWindowSubclass(hWnd, pfnCallback, 0, ObjPtr(pObj))
Set oCol = New Collection
oCol.Add hWnd
oCol.Add pfnCallback
Set InitSubclassingEasy = oCol
End Function
Public Function TerminateSubclassingEasy(pSubclass As IUnknown, pObj As Object) As IUnknown
Dim oCol As Collection
Set oCol = pSubclass
Call RemoveWindowSubclass(oCol.Item(1), oCol.Item(2), 0)
End Function
Public Function CallNextSubclassProc(pSubclass As IUnknown, ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
CallNextSubclassProc = DefSubclassProc(hWnd, wMsg, wParam, lParam)
End Function
'=========================================================================
' Add more redirectors here
'=========================================================================
Public Function RedirectForm1SubclassProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Form1) As Long
Dim bHandled As Boolean
RedirectForm1SubclassProc = dwRefData.frSubclassProc(hWnd, wMsg, wParam, lParam, bHandled)
If Not bHandled Then
RedirectForm1SubclassProc = DefSubclassProc(hWnd, wMsg, wParam, lParam)
End If
End FunctionCode:
'--- Form1.frm
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Private m_pSubclass As IUnknown
Private Sub Form_Load()
Set m_pSubclass = InitSubclassingEasy(hWnd, Me, AddressOf RedirectForm1SubclassProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
TerminateSubclassingEasy m_pSubclass, Me
End Sub
Friend Function frSubclassProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, Handled As Boolean) As Long
Const WM_GETMINMAXINFO As Long = &H24
Dim uInfo As MINMAXINFO
Debug.Print "wMsg=" & Hex(wMsg), Timer
If wMsg = WM_GETMINMAXINFO Then
Call CopyMemory(uInfo, ByVal lParam, LenB(uInfo))
uInfo.ptMinTrackSize.X = 500
uInfo.ptMinTrackSize.Y = 500
Call CopyMemory(ByVal lParam, uInfo, LenB(uInfo))
Handled = True
End If
End Functioncheers,
</wqw>