'
' For this application to work you will need
' 1 x Form
' 1 x Module
' 1 x User Control w/ Text Box Control on it
'
' Module Code
Option Explicit
Private Declare Function CallWindowProc _
Lib "user32" _
Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_RBUTTONUP As Long = &H205
Private OldWindowProc As Long
Public Sub HookWindow(txtTextBox As TextBox)
' Set the new window procedure to monitor the text boxes message queue. When our
' message is found it is picked out of the queue and proccess by our window
' procedure, any other messages are left alone and are processed by the original
' window procedure.
OldWindowProc = SetWindowLong(txtTextBox.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Public Sub UnhookWindow(txtTextBox As TextBox)
' Restore the old window procedure and cease monitoring the
' the message queue.
SetWindowLong txtTextBox.hwnd, GWL_WNDPROC, OldWindowProc
If OldWindowProc Then
OldWindowProc = 0
End If
End Sub
Private Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
' Intercept the right mouse button being released
Case WM_RBUTTONUP
' Process the message the way we want. If you comment the code in the form and run
' the application, right click on the text box, you will see the default text box
' menu. However now that we have intercepted the message we are altering it to do
' WE want it to do, in this instance, we are generating a message box.
MsgBox "Put the code that you want here when the user right clicks", vbInformation
' MSDN tells us to return 0 when ever we procces a message
NewWindowProc = 0
Case Else
' Restore the default handling for other messages. Remember that the text box
' will be recieving other messages to process. We are not interested in these
' so we let the default window procedure process them, not ours.
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Select
End Function
' Form Code
Option Explicit
Private Sub UserControl_Initialize()
HookWindow Text1
End Sub
Private Sub UserControl_Resize()
With Text1
.Height = UserControl.Height
.Width = UserControl.Width
End With
End Sub
Private Sub UserControl_Terminate()
UnhookWindow Text1
End Sub