下面的方法可以简单实现屏蔽系统菜单,但要有一个自己定义的菜单;
如果连自己的菜单也不弹出,我就不知道怎么办啦,替你关注。
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Text1.Enabled = False
Text1.Enabled = True
Me.PopupMenu menuNone'自定义菜单
程序中用到了CallWindowProc、SetWindowLong两个API函数,其中CallWindowProc函数用来发送消息到一个指定的窗口过程;而使用SetWindowLong函数来为窗口结构中为指定的窗口设置属性。使用API函数之前必须先在程序中声明如下:
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 Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'其中各参数的意义如下表:
Option Explicit
Public OldWindowProc As Long
'保存默认的窗口函数的地址
Public Const WM_CONTEXTMENU = &H7B
'当右击文本框时,产生这条消息
Public Const GWL_WNDPROC = (-4)
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
Public 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 MyMesg(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
If Msg <> WM_CONTEXTMENU Then
MyMesg = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
'如果消息不是WM_CONTEXTMENU,就调用默认的窗口函数处理
Exit Function
End If
MyMesg = True
End Function
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)
'取得窗口函数的地址
Call SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf MyMesg)
'用MyMesg代替窗口函数处理消息
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)
'恢复窗口的默认函数
'弹出自定义菜单
End Sub
Option Explicit
Private Sub Form_Load()
Call Hook(Text1.hWnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call UnHook
End Sub
'Model1代码:
Public 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_RBUTTONUP = &H205
Public lpPrevWndProc As Long
Private lngHWnd As Long
Public Sub Hook(hWnd As Long)
lngHWnd = hWnd
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHook()
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal _
lParam As Long) As Long
Select Case uMsg
'检测鼠标击键消息,如果是单击右键
Case WM_RBUTTONUP
' MsgBox "right button clicked."
Case WM_CUT, WM_COPY, WM_PASTE
Exit Function
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function