Option Explicit
Public OldWindowProc As Long ' 保存默认的窗口函数的地址
Public Const WM_CONTEXTMENU = &H7B ' 当右击文本框时,产生这条消息
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd _
As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Public Function SubClass_WndMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wp _
As Long, ByVal lp As Long) As Long
' 如果消息不是WM_CONTEXTMENU,就调用默认的窗口函数处理
If Msg <> WM_CONTEXTMENU Then
SubClass_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
Exit Function
End If
SubClass_WndMessage = True
End Function
窗体
Private Const GWL_WNDPROC = (-4)
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y _
As Single)
If Button = 1 Then Exit Sub
OldWindowProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC) ' 取得窗口函数的地址
' 用SubClass_WndMessage代替窗口函数处理消息
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage)
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then Exit Sub
' 恢复窗口的默认函数
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, OldWindowProc)
'PopupMenu mymenu 如果要调用自己的菜单,在此设置
End Sub
此法很灵:
先建一模块:
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Const GWL_WNDPROC = (-4)
Private Const WM_RBUTTONDOWN = &H204
Private m_lpPrevDisableRButtonDownWindowProc As Long
Function DisableRButtonDownWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_RBUTTONDOWN Then
Exit Function
End If
DisableRButtonDownWindowProc = CallWindowProc(m_lpPrevDisableRButtonDownWindowProc, hwnd, uMsg, wParam, lParam)
End Function
Public Function HookText(ByVal hwnd As Long) As Boolean
m_lpPrevDisableRButtonDownWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf DisableRButtonDownWindowProc)
End Function
Public Function UnHookText(ByVal hwnd As Long) As Boolean
Call SetWindowLong(hwnd, GWL_WNDPROC, m_lpPrevDisableRButtonDownWindowProc)
End Function
在:
Private Sub Form_Load()
HookText Text1.hwnd
End sub
Private Sub Form_UnLoad()
UnHookText Text1.hwnd
End sub