Subclassing questions

Unleash

New Member
Joined
Apr 15, 2011
Messages
13
So, as a follow up on my previous thread:

http://www.mrexcel.com/forum/showthread.php?p=2690602#post2690602

Which miserably failed. I have been testing and writing code all day to find out why things are not working.

I now know that the problem lies within the "hooking" of the userform. But I don't know why it keeps terminating when coming there. these are the two parts that do the hooking:

Code:
Private Sub List_Hook()
    'Maakt de Hook alleen als deze nog niet bestaat
    If Not blnHooked Then
        WheelHook FlensDefinitie
        blnHooked = True
    End If
End Sub

Code:
Public Sub WheelHook(ClientForm As UserForm)
    hWnd_UserForm = FindWindow("ThunderDFrame", ClientForm.Caption)
    lngWndProc = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, AddressOf WindowProc)
End Sub

The first one is called by mouseover events from the listboxes and from the Userform itself. Although when the mouseover event for the Userform gets raised, it isnt the hookup but the unhook path that is run. These are the subs for the unhooking:

Code:
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    LH = 0
    'Vernietigd de hook als de muis niet op de control is.
    Call List_UnHook
End Sub

Code:
 Private Sub List_UnHook()
    'Vernietigd de hook alleen als deze al bestaat
    If blnHooked Then
        WheelUnHook
        blnHooked = False
    End If
End Sub

Code:
Public Sub WheelUnHook()
Dim lRet As Long
    lRet = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, lngWndProc)
End Sub

The code fails the moment that the cursor comes onto the Userform, and the Mousemove event is raised. But since "blnHooked" is "false" from the beginning, nothing should happen.

Any idea on why the MouseMove event causes a crash??

Any help will be greatly appreciated!
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Why is that?

Most of the code is in VBa and the part that is API is integrated with vba... So it is an vba problem, right?

But If the forum requires it, I hereby want to ask an admin to move this thread.

Edit:
Ow, "Other languages" isnt about coding languages... Well, still I think it should be right where it is. The comments are purely for me, and are of no use to others. Besides all the comments in the code are already explained in my post... So no need for native Dutch speakers.
 
Last edited:
Upvote 0
Your code does not cause my Excel to crash, FWIW (after fixing the various missing declarations and converting most of the code in your other post to Public from Private).
I'd also suggest you use:
Code:
WheelHook Me
rather than:
Code:
WheelHook FlensDefinitie
 
Upvote 0
Hey Thanks,

Well those missing variables are all declared in another module (the main module of the project) and are all public variables.

I changed the Me statements to the name of the userform (Flensdefinitie) cause I thought that that could be a part where the problems started out.
But maybe it made things even worse... Ill retry tomorrow (Im currently not at my Workstation so I cant access the code).
 
Upvote 0
One thing you should do is ensure that you have error handling in any procedure called by the hook - ie the WindowProc and any routines it calls - even if it's just On Error Resume Next.
I would also suggest it would be easier if you give the mousewheel proc the same name in each userform.
 
Upvote 0
I did change the name thing, and I build in error handling in the mousewheelproc's. Those are the only ones big enough for error handling.

Still I retried and the prog is still crashing now and then. It isnt a pattern or something alike, its purely random if it crashes but if it does its always at the same line.

Maybe the code isnt handled fast enough for windows, and is it seeing the prog as a risk and therefor shutting it down...?
 
Upvote 0
This is the current code to intercept the API call:
Code:
'this traps the mousewheel scroll message as it's sent to your form by Wiindows,
'then it calls the procedure in the form's code module in order to scroll the list
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
    If lMsg = WM_MouseWheel Then
        MouseKeys = wParam And 65535
        Rotation = wParam / 65536
        Screen.ActiveForm.MouseWheelRoll Rotation
    ElseIf IMsg <> WM_MouseWheel Then
        WindowProc = CallWindowProc(lngWndProc, lWnd, lMsg, wParam, lParam)
    End If
End Function

This is the current code for the mousewheel proc's:
Code:
Public Sub MouseWheelRoll(ByVal Rotation As Long)
Dim lngNewIndex As Long
Static intCounter As Integer
On Error GoTo Err_Hand
    'Zorgt ervoor dat er maar per 3 keer "langskomen" ook daadwerkelijk iets gebeurt.
1    intCounter = intCounter + 1
Debug.Print "intCounter: " & intCounter
Debug.Print "LH: " & LH
2    If Not intCounter = 3 Then Exit Sub
3    intCounter = 0
4        With Me.ActiveControl
5            If Rotation < 0 Then
6                lngNewIndex = .ListIndex + 1
7                If .ListCount > lngNewIndex Then .ListIndex = lngNewIndex
8            Else
9            If Not .ListIndex <= -1 Then .ListIndex = .ListIndex - 1
10            End If
11        End With
Exit Sub
Err_Hand:
ErLine = Erl
ErNum = Err.Number
ErDesc = Err.Description
ErSrc = Err.Source
msg = "Er is een fout opgetreden, excel wordt afgesloten. De fout is opgetreden in " & ErSrc & "op lijn: " & ErLine & ". De fout omschrijving is: " & ErDesc & "."
hdr = "Error"
On Error GoTo 0
Call Errhandler
End Sub
 
Upvote 0
Again, you really must put an error handler into the WindowsProc function. If an unhandled error occurs in there, it would most likely crash your system.
 
Upvote 0

Forum statistics

Threads
1,224,586
Messages
6,179,730
Members
452,939
Latest member
WCrawford

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top