Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,797
- Office Version
- 2016
- Platform
- Windows
Hi dear excellers,
I have put together this project which subclasses userforms (can be extended to other windows) and I would like to know if it works as expected for trapping window messages. I am particularly interested to know if the project is stable enough. Meaning: It dosen't shuts down the entire excel application if an unhandled error occurs while the form(s) is (are) subclassed or when pressing the Break, Reset or the Design Mode buttons in the VBE ... Subclassing is notoriously limited in vba if not outright inoperational. Hopefully, with this technique, the crashings will be overcome.
Clicking the 'Raise Error' button on the first form or right-clicking its titlebar should cause an intentional error to help the testings.
Basically, the project makes use of two dlls that I have written and compiled in TwinBasic (one dll is for x32bit excel and the other one is for x64bit) ... I have embedded the dlls binary data in two modules as base64 strings, just like reources for portability reasons ... The code automatically takes care of everything from decoding the base64 strings to extracting the dll bytes and saving them to the temp directory as dll files.
Please, try resizing, moving the forms as well as right-clicking the form's titlebar to see the action.
Thanks.
File for download:
SubclassDll_ VBA_x32_x64.xlsm
Here is the event handler for the first form :
For the second form :
I have put together this project which subclasses userforms (can be extended to other windows) and I would like to know if it works as expected for trapping window messages. I am particularly interested to know if the project is stable enough. Meaning: It dosen't shuts down the entire excel application if an unhandled error occurs while the form(s) is (are) subclassed or when pressing the Break, Reset or the Design Mode buttons in the VBE ... Subclassing is notoriously limited in vba if not outright inoperational. Hopefully, with this technique, the crashings will be overcome.
Clicking the 'Raise Error' button on the first form or right-clicking its titlebar should cause an intentional error to help the testings.
Basically, the project makes use of two dlls that I have written and compiled in TwinBasic (one dll is for x32bit excel and the other one is for x64bit) ... I have embedded the dlls binary data in two modules as base64 strings, just like reources for portability reasons ... The code automatically takes care of everything from decoding the base64 strings to extracting the dll bytes and saving them to the temp directory as dll files.
Please, try resizing, moving the forms as well as right-clicking the form's titlebar to see the action.
Thanks.
File for download:
SubclassDll_ VBA_x32_x64.xlsm
Here is the event handler for the first form :
VBA Code:
Private Sub oSubclass_MessageReceived( _
hwnd As LongPtr, _
uMsg As Long, _
wParam As LongPtr, _
lParam As LongPtr, _
dwRefData As LongPtr, _
bDiscardMessage As Boolean, _
lReturnValue As LongPtr _
)
Const WM_SETCURSOR = &H20, WM_GETMINMAXINFO = &H24, WM_CONTEXTMENU = &H7B
Select Case uMsg
Case WM_SETCURSOR 'Hover the mouse over the form.
Debug.Print Me.Name, Format(Now, "hh:mm:ss")
Case WM_GETMINMAXINFO 'Resize the form.
Call CheckMinMaxInfo(lParam, bDiscardMessage)
Case WM_CONTEXTMENU 'Right-click the form titlebar to raise error..
Debug.Print 1 / 0 'Raising an error shows that excel doesn't crash (doesn't shut down) !!
End Select
End SubFor the second form :
VBA Code:
Private Sub oSubclass_MessageReceived( _
hwnd As LongPtr, _
uMsg As Long, _
wParam As LongPtr, _
lParam As LongPtr, _
dwRefData As LongPtr, _
bDiscardMessage As Boolean, _
lReturnValue As LongPtr _
)
Const WM_SYSCOMMAND = &H112, SC_MOVE = &HF012&, WM_NCLBUTTONUP = &HA2
Const WM_SETCURSOR = &H20, WM_NCMOUSELEAVE = &H2A2
Select Case uMsg
Case WM_SYSCOMMAND 'Move the form
If wParam = SC_MOVE Then
Label1 = "Sorry, this form is unmovable."
bDiscardMessage = True 'abort message.
End If
Case WM_NCLBUTTONUP 'move the form
Label1 = ""
Case WM_SETCURSOR
If GetAsyncKeyState(VBA.vbKeyLButton) = 0& Then
Label1 = ""
End If
Case WM_NCMOUSELEAVE
If GetParent(WndFromPoint(hwnd)) <> hwnd Then
Label1 = "": Call MonitorMouse
End If
End Select
End Sub
