Или вот так, хотя первый вариант, наверное, попроще:
| Код |
'Form1
Option Explicit
' Textmenu sample by Matt Hart - [email protected]
' http://matthart.com
'
' This sample shows how to subclass a text box and replace its
' default right-click edit menu with one of your own.
Private Sub Form_Load()
Call SetHook(Text1.hwnd, True)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call SetHook(Text1.hwnd, False)
End Sub
Private Sub mnuPrint_Click()
MsgBox "Print!"
End Sub
'Module1.bas
' Textmenu sample by Matt Hart - [email protected]
' http://matthart.com
Option Explicit
Public Const GWL_WNDPROC = (-4)
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Const WM_MOUSEACTIVATE = &H21
Public Const WM_RBUTTONDOWN = &H204
Public origWndProc As Long
Public Sub SetHook(hwnd, bSet As Boolean)
If bSet Then
origWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf AppWndProc)
ElseIf origWndProc Then
Dim lRet As Long
lRet = SetWindowLong(hwnd, GWL_WNDPROC, origWndProc)
End If
End Sub
Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_MOUSEACTIVATE
Dim C As Integer
Call CopyMemory(C, ByVal VarPtr(lParam) + 2, 2)
If C = WM_RBUTTONDOWN Then
Form1.PopupMenu Form1.mnuBP
SendKeys "{ESC}"
End If
End Select
AppWndProc = CallWindowProc(origWndProc, hwnd, Msg, wParam, lParam)
End Function
|
Об копирайте некий Мэтт Харт сам позаботился. 
P.S. У умных людей этот вариант называется "сабклассинг". |