Subclassing At Its Simplest

[Elroy]

There are several examples of how to subclass in this CodeBank. However, most go into complexities of how to "protect the IDE".

ADDED:

• There's lots of discussion now in this thread, but it all has to do with protecting the IDE. However, I'll stand by what I've said in this OP.
• Also, I'm including several specific subclassing snippets for various subclassing tasks that can be inserted into this subclassing module. I'll post links to those posts at the bottom of this OP.
• Added the ProgramIsRunning module level Boolean, which provides a bit of IDE protection (which I always use, and included here so I could grab this for my own use).

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:

Option Explicit
'
Public ProhibitSubclassing  As Boolean      ' Just in case we want to suppress any/all of our subclassing.
'
Private ProgramIsRunning    As Boolean      ' Used when in IDE to try and detect "Stop" button being clicked.
'
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
    If Not ProgramIsRunning Then ' Protect the IDE.  Don't execute any specific stuff if we're stopping.  We may run into COM objects or other variables that no longer exist.
        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


' ************************************************************
' ************************************************************
' Additional types of subclassing can be inserted below.
' ************************************************************
' ************************************************************






' ************************************************************
' ************************************************************
' 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 ProhibitSubclassing Then Exit Sub
    ProgramIsRunning = True
    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 ProhibitSubclassing Then Exit Sub
    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 ProhibitSubclassing Then Exit Function
    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
    If ProhibitSubclassing Then Exit Function
    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

And here's some code for a Form1, for testing:

Option Explicit

Private Sub Form_Load()
    SubclassToSeeMessages Me.hWnd
End Sub

Specific Subclassing Tasks:

• To detect when a form is moving.
• To detect when a form in our project has completely lost the focus to an entirely different application.
• Keep form at bottom of all top-level windows (not just the project's forms).
• To detect mouse wheel events.

[dz32]

Probably ide safe if it was used from an active x dll?

[VanGoghGaming]

The ActiveX DLL runs in the same process so I can't see how it would make any difference. I've tried it but maybe I'm missing something...

[dz32]

the subclassing code I use with setwindowlong is IDE safe but doesnt do anything fancy so I always assumed just wrapping it in a dll was enough and the terminate event always gets called correctly even on IDE stop button.

[VanGoghGaming]

As far as I know, pressing the stop button prevents any more code from executing and resets all variables to zero. The only workarounds I've seen are complicated assembly thunks that intercept some msvbvm60.dll functions that have to do with debugging the IDE in breaking mode (probably in the same way the IDE deals with its own subclassing).

What is your subclassing code with setwindowlong?

[dz32]

A quick test would be to just put a msgbox in dll class terminate, use it from exe test and hit stop in ide. Code on another computer

[VanGoghGaming]

It's worth a shot. But the "Class_Terminate" event doesn't know which "hWnds" have been subclassed in order to unsubclass them. They would have to be stored in some sort of collection.

[xiaoyao]

There are several examples of how to

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

else

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
end if

ToSeeMessages_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

[/code]

Will the code be simpler?

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&
'
??????WM_DESTROY???????????????
' Although, there are a few rare situations where we do need to explicitly un-subclass.

Select Case uMsg ' Just use this to eliminate ones we don't want, as the message pump is quite noisy.

case WM_DESTROY 
UnSubclassSomeWindow hWnd, AddressOf_ToSeeMessages_Proc, uIdSubclass

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

[nebeln]

This subclassing "only" refeers to ActiceX (OCX'S) and Common Controls!!
The subclassing as it "simpliest" is as follwing:

m_OldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MainMenuWndProc)

And the Unsubclass procedure MUST BE DONE BEFORE Form1_Terminate

SetWindowLong hWnd, GWL_WNDPROC, m_OldWndProc

THIS REFERS TO MAIN WINDOW/FORM and other "old" controls!!

[xiaoyao]

usercontrol,If it terminates unexpectedly, or is forced to terminate in the VB6 IDE.Failure to properly exit the subclassing process causes a crash.

[nebeln]

Yes, fatal crash. So running a active x (ocx) control in IDE while subclassed is a bad idea.
In a usercontrol you can use Usercontrol.Ambient.UserMode = False to ensure the subclassing not occure while you are in designmode.
This should be done in UserControl_Show() method/procedure.

Cheers ???

[The trick]

The only workarounds I've seen are complicated assembly thunks that intercept some msvbvm60.dll functions that have to do with debugging the IDE in breaking mode (probably in the same way the IDE deals with its own subclassing).?

This isn't required. You just need to use an COM object which is released when the code stops.

[Elroy]

This isn't required. You just need to use an COM object which is released when the code stops.

That's not the worst of ideas. But doing a callback into a COM object still requires a thunk. So six-of-one, half-a-dozen of the other.

I guess we could put the actual callback code in a BAS module, and then that callback procedure immediately calls the COM object which checks for things like WM_DESTROY coming through the message pump. I haven't tested, but that might eliminate the need for a thunk. Although it would require two modules to get subclassing done (one BAS and one COM).

[Elroy]

Also, another point on which there seems to be confusion.

Once compiled (and the IDE is out of the picture for the code doing the subclassing), none of this IDE protection matters. And this is true even if we get errors. Once compiled, our "explicit" subclassing isn't any different than the plethora of "implicit" subclassing that VB6 is doing all over the place. That's how a simple Control_Click event gets raised. It's only that "stop running and go back to the IDE" interim step that causes any problems at all. If we're just completely terminating, then no problem.

And that's true for any compiled ActiveX component, even if we're using that compiled component with other code that's in the IDE.

[wqweto]

Btw, the IDE-safe claim is. . . bold, the least I can say.

Yes, the IDE will not explode if the user executes parts of the code which do not touch subclassing :-))

cheers,
</wqw>

[nebeln]

And yes, there is therefore I have answered in this thread at #11
The only real subclassing is outside the IDE and subclassed while in IDE is not a very good idea and should be avoided but sometimes it need to be a subclass within the IDE.
Now is this for ocx’s (ActiveX).

[The trick]

That's not the worst of ideas. But doing a callback into a COM object still requires a thunk. So six-of-one, half-a-dozen of the other.

I meant we don't need to intercept any msvbvm60 functions (as VanGoghGaming wrote). So if you use an external DLL with a COM object you can use safe subclassing in IDE. Mine uses this approach but inside the asm thunk. BTW it has a bug but it isn't related to approach rather to my carelessness.

[TomCatChina]

Irrelevant to the topic, open a new thread

[The trick]

Hello,the trick,Glad to see you have time to interact on the forums. In a compiled exe file, is it possible to enumerate all its standard modules and the names of the functions in them and their corresponding addresses?

Create a separate thread. As far as i remember you can enumerate standard modules (and their ranges) but can't enumerate functions (only heuristic analysis) in native code (only in p-code).

[Elroy]

Ok, a couple of things, since we're so intent on discussing IDE protection. First...

As far as I know, pressing the stop button prevents any more code from executing and resets all variables to zero.

That isn't entirely true. The second part is true, but the first part isn't. In fact, the fact that pressing the stop button immediately sets all variables to zero, I use that in my production subclassing to protect the IDE in situations where I'm clicking stop without a modal form showing. And, the message pump will still run a few things through our subclass procedure even after the stop button is clicked. Sadly, it doesn't always run a WM_DESTROY through it, so I set a global and then check it for zero, and un-subclass if it is.

What is your subclassing code with setwindowlong?

I haven't done that in so long, I forget. I'd have to dig deep in my archives to find some of that.

------------------

And lastly, I tried The Trick's suggestion, and it didn't seem to work.

I created the following Class module (named clsSubclassIdeProtection), with this code:

Option Explicit

Dim collTracking As New Collection


Friend Sub AddNewSubclassing(hWnd As Long, AddressOf_ProcToSubclass As Long, uIdSubclass As Long)
    ' With the comctl32.dll approach to subclassing, you can repeatedly do the subclassing,
    ' and it doesn't hurt anything.  It doesn't add two subclass "links" in.  It just
    ' potentially updates the dwRefData.  But, for our tracking purposes, we use error
    ' trapping so we're not erroring when trying to add a key that's already in the collection.
    '
    On Error Resume Next
        collTracking.Add CStr(hWnd) & "|" & CStr(AddressOf_ProcToSubclass) & "|" & CStr(uIdSubclass)
    On Error GoTo 0
End Sub

Private Sub Class_Terminate()
    ' This is what protects the IDE.  When exiting, we spin through all our subclassing
    ' and unsubclass everything we've subclassed.
    '
    If collTracking.Count = 0& Then Exit Sub
    '
    Dim v As Variant
    Dim sa() As String
    Dim hWnd As Long, AddressOf_ProcToSubclass As Long, uIdSubclass As Long
    For Each v In collTracking
        sa = Split(v, "|")
        hWnd = CLng(sa(0&))
        AddressOf_ProcToSubclass = CLng(sa(1&))
        uIdSubclass = CLng(sa(2&))
        UnSubclassSomeWindow hWnd, AddressOf_ProcToSubclass, uIdSubclass
    Next
End Sub

Then, anytime I subclassed, I called that AddNewSubclassing method.

Then, I put the following in a Form1:

Option Explicit

Private Sub Form_Load()
    SubclassToSeeMessages Me.hWnd
End Sub


Private Sub Form_Click()
    Debug.Print 1 / 0 ' Create an error so we can click the "End" button.
End Sub

I did tests several ways (making sure the collection was being populated). But, when the "End" button is clicked on an error, that Class_Terminate does not get executed.

It doesn't get executed if we click the "Stop" button either. However, in that situation, the WM_DESTROY does come through the message pump after the "Stop" button is clicked.

---------------

So, bottom line, it takes a thunk if we truly want to protect our IDE when subclassing.

[dz32]

or use the subclassing code from an ActiveX dll which gets class_terminate called even when IDE stop button get hit

[Elroy]

or use the subclassing code from an ActiveX dll which gets class_terminate called even when IDE stop button get hit

Hmmm, for me, that's not even worth testing. Although, I suppose it might be for some.

The reason it's not of use for me is, I pretty much always insist that I can manifest my executables and run them SxS. I suppose I could do that for this subclassing ActiveX, but it seems that a thunk is less work if I'm really that concerned about it.

I tend to use subclassing fairly often, even in little "utility" programs I write. To have a dependency on an ActiveX would be very undesirable for me.

If I'm developing (i.e., using the IDE), I might put a startup question asking if I want to subclass or not. But, beyond that, I'm actually quite happy with the way I do subclassing.

------------

Someone in another thread recently said, "Just don't click the 'Stop' button" and I actually agree with that. It gets a bit more difficult when we get a runtime error that's difficult to get past, but that's the nature of development.

[The trick]

And lastly, I tried The Trick's suggestion, and it didn't seem to work.

So if you use an external DLL with a COM object you can use safe subclassing in IDE.

You need to use any compiled code (DLL/Thunk).

[Elroy]

You need to use any compiled code (DLL/Thunk).

Hey, thanks. But ... see post #22. And hey, always good to see you Trick.

[dz32]

Hmmm, for me, that's not even worth testing. Although, I suppose it might be for some.

I hear ya, Im opposite, for me its the only way. Keeps the subclassing simple with no hacks or debugging limitations. Everything I do requires external dependencies anyway so whats one more. Although I have used / do trust Paul Caton's cSubclass.cls but thats outside of simple

[Elroy]

I hear ya, Im opposite, for me its the only way. Keeps the subclassing simple with no hacks or debugging limitations. Everything I do requires external dependencies anyway so whats one more. Although I have used / do trust Paul Caton's cSubclass.cls but thats outside of simple

Y'all actually have me thinking about this. I'm wondering if subclassing the IDE's main window (Class="IDEOwner") and then monitoring that thing for WM_SETTEXT, and then unsubclassing everything if the end of its text goes back to "[design]" would work.

It's going to depend on the order in which things happen. If that IDE title gets changed early (before everything switches back to pure design mode), then it may work. I'm putting together a test now (probably after lunch though).

------------

As a note, I searched all the top-level windows of an IDE's thread, and there are no new hidden windows created when we execute in the IDE. If there were, I was going to subclass that window, but no cigar.

[wqweto]

No, this is not going to fly because the moment you hit End button the interpreter stops executing p-code. You’ll need compiled code in a DLL or thunk to do the cleanup. This is the whole idea — use compiled VB6 code, compiled to a DLL so that cleanup can happen with this VB6 code (no ASM or thunks)

[VanGoghGaming]

That isn't entirely true. The second part is true, but the first part isn't. In fact, the fact that pressing the stop button immediately sets all variables to zero, I use that in my production subclassing to protect the IDE in situations where I'm clicking stop without a modal form showing. And, the message pump will still run a few things through our subclass procedure even after the stop button is clicked. Sadly, it doesn't always run a WM_DESTROY through it, so I set a global and then check it for zero, and un-subclass if it is.

Yes that is correct. If you are subclassing a form then you can always watch for the "WM_UAHDESTROYWINDOW" (&H90) message in your "WndProc" and safely unsubclass right there. The IDE sends the "WM_UAHDESTROYWINDOW" message to a form when you press the "Stop" button (but NOT when you press the "End" button)!

However this trick doesn't work when you implement your subclassing code in a class rather than in a form...

I haven't done that in so long, I forget. I'd have to dig deep in my archives to find some of that.

That message was intended for dz32 about his "SetWindowLong" method that was "IDE safe" but he said the code was on another computer. I was curious about it because the "comctl32" method is just a fancy wrapper for "SetWindowLong". It just adds a bunch of properties to the subclassed hWnd (with "SetProp") to make it easier to manage them and it also keeps an internal ordered list to respect the order of unsubclassing.

[Elroy]

No, this is not going to fly because the moment you hit End button the interpreter stops executing p-code. You’ll need compiled code in a DLL or thunk to do the cleanup. This is the whole idea — use compiled VB6 code, compiled to a DLL so that cleanup can happen with this VB6 code (no ASM or thunks)

I'm about ready for a test.

The only problem I'm having right now is keeping track of what I've subclassed.

I was going to use a Collection, but then it dawned on me that the Collection would be gone the moment I clicked "Stop" or "End". So, I'm now looking into a way to use the ComCtl32.dll to iterate its subclassing. We'll see. Otherwise, I'll have to use some Windows API to stuff all my subclassing info into. I suppose I could use the registry, but IDK. I do know that some people get nervous about programs that use the registry.

-------

By the way, I have tested, and I am getting some WM_SETTEXT messages after "Stop" is clicked when I've subclassed the IDE (class="IDEOwner").

[dz32]

the subclass code I use is just the standard vanilla setwindowlong. It is only IDE safe because it is in an ActiveX dll.

Its very similar to the vb accelerator one. http://www.vbaccelerator.com/home/vb...er/article.asp

I think the original one I saw like this was from Bruce McKinney's Hardcore Visual Basic where they used setprop to store the old wndproc as an attribute of the hwnd being hooked.

https://classicvb.net/hardweb/mckinney2a.htm

HardCore3.zip 
  /Components/
      Subclass.bas
      ISubclass.cls
      Subclass.cls

Paul Cantons cSubclass.cls is IDE safe without a dll because it hooks vba6.dll EbMode if it detects its running in the IDE and uses asm thunks. runs flawless, but its still black magic which i generally avoid.

[Elroy]

I give up.

I'm subclassing the main IDE window, and when I click "End" on a runtime error message, I've got Debug.Print statements showing me that it's un-subclassing everything (including the IDE window), but the IDE still crashes.

All I can guess is that it's doing that hard-destroy (no WM_DESTROY) before I can get to it ... a matter of timing, as I thought might happen.

Or maybe, as wqweto says, the p-code just gets into some state that it can no longer be called (or no longer has a stable memory address). But that doesn't make sense because my Debug.Print statements are showing me that I am getting everything un-subclassed.

IDK, but I've got other unfinished projects.

[VanGoghGaming]

It's worth a shot. But the "Class_Terminate" event doesn't know which "hWnds" have been subclassed in order to unsubclass them. They would have to be stored in some sort of collection.

Just got around to trying this and I can't believe it actually works and I haven't thought about using "Class_Terminate" before! Thanks for the tip dz32!

Now you can easily debug subclassed procedures in IDE and the "Stop" button works great without crashing. Still no dice with the "End" button but a huge improvement nevertheless!

cSC.cls (main class in an ActiveX DLL, Instancing set to "5 - MultiUse")

Option Explicit

Private colSubclassedWnds As Collection

Public Function IsWndSubclassed(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long) As Boolean
    IsWndSubclassed = mdlSC.IsWndSubclassed(hWnd, uIdSubclass, dwRefData)
End Function

Public Function SubclassWnd(hWnd As Long, vSubclass As Variant, Optional dwRefData As Long, Optional bUpdateRefData As Boolean) As Boolean
    SubclassWnd = mdlSC.SubclassWnd(hWnd, vSubclass, dwRefData, bUpdateRefData)
    If SubclassWnd And Not bUpdateRefData Then colSubclassedWnds.Add hWnd, CStr(hWnd)
End Function

Public Function UnSubclassWnd(hWnd As Long, Optional vSubclass As Variant) As Boolean
    UnSubclassWnd = mdlSC.UnSubclassWnd(hWnd, vSubclass)
    If UnSubclassWnd Then colSubclassedWnds.Remove CStr(hWnd)
End Function

Private Sub Class_Initialize()
    Set colSubclassedWnds = New Collection
End Sub

Private Sub Class_Terminate()
Dim i As Long
    For i = 1 To colSubclassedWnds.Count ' Safely remove subclassing if the "Stop" button was clicked
        mdlSC.UnSubclassWnd CLng(colSubclassedWnds(i))
    Next i
End Sub

ISubclass.cls (interface class to use with "Implements", Instancing set to "2 - PublicNotCreatable")

Option Explicit

Public Function WndProc(hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, dwRefData As Long, bDiscardMessage As Boolean) As Long

End Function

mdlSC.bas (module containing the actual subclassing functions)

Option Explicit

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
Private Declare Function GetWindowSubclass Lib "comctl32" 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" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "#350" (dstObject As Any, ByVal srcObject As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long

Public Function IsWndSubclassed(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long) As Boolean
    IsWndSubclassed = GetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
End Function

Public Function SubclassWnd(hWnd As Long, vSubclass As Variant, Optional dwRefData As Long, Optional bUpdateRefData As Boolean) As Boolean
Dim Subclass As ISubclass, uIdSubclass As Long, lOldRefData As Long
    If IsObject(vSubclass) Then Set Subclass = vSubclass Else vbaObjSetAddref Subclass, vSubclass
    uIdSubclass = ObjPtr(Subclass)
    If Not IsWndSubclassed(hWnd, uIdSubclass, lOldRefData) Then
        SetProp hWnd, hWnd, uIdSubclass: SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
    Else
        If bUpdateRefData Then If lOldRefData <> dwRefData Then SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
    End If
End Function

Public Function UnSubclassWnd(hWnd As Long, Optional vSubclass As Variant) As Boolean
Dim Subclass As ISubclass, uIdSubclass As Long
    If IsMissing(vSubclass) Then
        uIdSubclass = GetProp(hWnd, hWnd)
    Else
        If IsObject(vSubclass) Then Set Subclass = vSubclass Else vbaObjSetAddref Subclass, vSubclass
        uIdSubclass = ObjPtr(Subclass)
    End If
    If IsWndSubclassed(hWnd, uIdSubclass) Then RemoveProp hWnd, hWnd: UnSubclassWnd = RemoveWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass)
End Function

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Subclass As ISubclass, ByVal dwRefData As Long) As Long
Dim bDiscardMessage As Boolean
    Select Case uMsg
        Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
            UnSubclassWnd hWnd
        Case Else
            WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam, dwRefData, bDiscardMessage) ' bDiscardMessage is passed ByRef so it can be toggled as required by each local Subclass_WndProc
    End Select
    If Not bDiscardMessage Then WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam) ' Choose whether to pass along this message or discard it
End Function

Obviously we only need this ActiveX DLL while working in the IDE and there is no use for it in compiled programs so we can use a conditional compilation argument aptly named "bInIDE" to distinguish what kind of subclassing we want to use:

In a standard EXE project:

Option Explicit

#If bInIDE Then
    Implements prjSafeSubclassing.ISubclass
#Else
    Implements ISubclass
#End If

Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long

Private Const WM_LBUTTONUP As Long = &H202, WM_CONTEXTMENU As Long = &H7B, WM_HOTKEY As Long = &H312, MOD_ALT As Long = &H1, MOD_CONTROL As Long = &H2

Private Sub Form_Load()
    RegisterHotKey hWnd, &HABCD&, MOD_ALT Or MOD_CONTROL, vbKeyBack
    SubclassWnd hWnd, Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnregisterHotKey hWnd, &HABCD&
End Sub

Private Function ISubclass_WndProc(hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, dwRefData As Long, bDiscardMessage As Boolean) As Long
    Select Case uMsg
        Case WM_LBUTTONUP
            Debug.Print Log(0) ' Run-time error 5: Invalid procedure call or argument
                               ' We can safely debug and skip past this error in IDE
        Case WM_CONTEXTMENU
            Debug.Print "Context Menu"
        Case WM_HOTKEY
            If (lParam And &HFFFF&) = (MOD_ALT Or MOD_CONTROL) Then
                Select Case lParam \ 65536
                    Case vbKeyBack ' Press Ctrl-Alt-Backspace to quit (the form doesn't need to be in the foreground)!
                        Unload Me
                End Select
            End If
    End Select
End Function

mdlSC.bas (module for subclassing in a standard EXE project using the conditional compilation argument bInIDE)

Option Explicit

Private Const WM_NCDESTROY As Long = &H82

Private Declare Function SetWindowSubclass Lib "comctl32" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32" 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" 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
Private Declare Function vbaObjSetAddref Lib "msvbvm60" Alias "#350" (dstObject As Any, ByVal srcObject As Long) As Long

#If bInIDE Then
    Private cSC As New prjSafeSubclassing.cSC ' ActiveX DLL containing a copy of these subclassing functions for using while in IDE
#End If

Public Function SubclassWnd(hWnd As Long, vSubclass As Variant, Optional dwRefData As Long, Optional bUpdateRefData As Boolean) As Boolean
    #If bInIDE Then
        SubclassWnd = cSC.SubclassWnd(hWnd, vSubclass, dwRefData, bUpdateRefData)
    #Else
        Dim Subclass As ISubclass, uIdSubclass As Long, lOldRefData As Long
        If IsObject(vSubclass) Then Set Subclass = vSubclass Else vbaObjSetAddref Subclass, vSubclass
        uIdSubclass = ObjPtr(Subclass)
        If Not IsWndSubclassed(hWnd, uIdSubclass, lOldRefData) Then
            SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
        Else
            If bUpdateRefData Then If lOldRefData <> dwRefData Then SubclassWnd = SetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
        End If
    #End If
End Function

Public Function UnSubclassWnd(hWnd As Long, vSubclass As Variant) As Boolean
    #If bInIDE Then
        UnSubclassWnd = cSC.UnSubclassWnd(hWnd, vSubclass)
    #Else
        Dim Subclass As ISubclass, uIdSubclass As Long
        If IsObject(vSubclass) Then Set Subclass = vSubclass Else vbaObjSetAddref Subclass, vSubclass
        uIdSubclass = ObjPtr(Subclass)
        If IsWndSubclassed(hWnd, uIdSubclass) Then UnSubclassWnd = RemoveWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass)
    #End If
End Function

Public Function IsWndSubclassed(hWnd As Long, uIdSubclass As Long, Optional dwRefData As Long) As Boolean
    #If bInIDE Then
        IsWndSubclassed = cSC.IsWndSubclassed(hWnd, uIdSubclass, dwRefData)
    #Else
        IsWndSubclassed = GetWindowSubclass(hWnd, AddressOf WndProc, uIdSubclass, dwRefData)
    #End If
End Function

Private Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Subclass As ISubclass, ByVal dwRefData As Long) As Long
Dim bDiscardMessage As Boolean
    Select Case uMsg
        Case WM_NCDESTROY ' Remove subclassing as the window is about to be destroyed
            UnSubclassWnd hWnd, Subclass
        Case Else
            WndProc = Subclass.WndProc(hWnd, uMsg, wParam, lParam, dwRefData, bDiscardMessage) ' bDiscardMessage is passed ByRef so it can be toggled as required by each local Subclass_WndProc
    End Select
    If Not bDiscardMessage Then WndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam) ' Choose whether to pass along this message or discard it
End Function

I can't believe nobody has bothered to post this simple and yet so powerful method before although in all fairness there are examples using assembly thunks that can manage pressing the "End" button as well!

Here is the demo project (including the ActiveX DLL) for who wants to try it: SafeSubclassing.zip

[Elroy]

VanGogh: Did you test the "Stop" button while a MsgBox was on the screen? And also while a second vbModal form was on the screen? Those are the only conditions that give me problems.


And, the runtime error "End" button is particularly nettlesome, because I sometimes run into errors that are difficult to circumvent. I've found a way to regain control of the debugger (and the ability to "Set Next Statement") but I'm still playing with it, trying to make it robust to just clicking "End" rather than "Debug".

[The trick]

Elroy, does mine crash? This should survive both the stop button and end statement.

[Elroy]

Elroy, does mine crash? This should survive both the stop button and end statement.

Yours with the thunk? Oh gosh, no no, I haven't had a problem with yours.

I think we're just exploring the possibility of doing it (complete IDE protection) without a thunk. Admittedly, it's pretty much just an academic exercise (another alternative to things that already work).

And, truth be told, I'm still playing with ideas to do it without a thunk nor an ActiveX component.

[wqweto]

Elroy, does mine crash? This should survive both the stop button and end statement.

CTrickSubclass.zip -- put breakpoint on Private Sub m_pSubclass_WndProc in ctxTrackMouse, run project and immediately press Stop

cheers,
</wqw>

[Elroy]

CTrickSubclass.zip -- put breakpoint on Private Sub m_pSubclass_WndProc in ctxTrackMouse, run project and immediately press Stop

No question, that's excellent code. It does have a thunk in it though. But hey, again, it's excellent code and does seem to provide complete IDE protection. In fact, I just tested on "modal second form, clicking Stop", and also clicking "End" on a runtime error. Works perfectly. That's probably about the best alternative there is, and it even avoids any registered ActiveX.

[The trick]

CTrickSubclass.zip -- put breakpoint on Private Sub m_pSubclass_WndProc in ctxTrackMouse, run project and immediately press Stop

cheers,
</wqw>

Thank you for testing but i think it isn't related to my class. Remove all the subclassing thing and do the same with UserControl_Resize event.



VB6 tries to activate this Usercontrol-OLE-object and you stop this process - it shows error (another VB6 bug).

[The trick]

No question, that's excellent code. It does have a thunk in it though. But hey, again, it's excellent code and does seem to provide complete IDE protection. In fact, I just tested on "modal second form, clicking Stop", and also clicking "End" on a runtime error. Works perfectly. That's probably about the best alternative there is, and it even avoids any registered ActiveX.

Thank you but it had a bug related to recursive releasing (just remove UnmapViewOfFile from Class_terminate to avoid this rare case bug).

[nebeln]

All subclassing goes to hell of you press the "STOP" button if you choose to subclass in the IDE mode and unsubclass in IDE mode!!
Only way to not get this is to to make the subclassing in runtime outside the IDE!!
It doesn't matter how or else...just don't subclass in IDE!! and not unsubclass in IDE!!