'模块: Option Explicit 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 Const WM_RBUTTONDOWN = &H204 Public oldproc As Long Public Function RegisterWindow(hwnd As Long) As Long If hwnd <> 0 Then oldproc = SetWindowLong(hwnd, -4, AddressOf WinProc) End If End Function Public Function unRegisterWindow(hwnd As Long) As Long
If hwnd <> 0 Then SetWindowLong hwnd, -4, oldproc End IfEnd Function Public Function WinProc(ByVal hwnd As Long, ByVal msg As Long, ByVal lpara As Long, ByVal wpara As Long) As LongIf msg = WM_RBUTTONDOWN Then Exit Function End IfWinProc = CallWindowProc(oldproc, hwnd, msg, lpara, wpara) End Function '窗体 Private Sub Form_Load() RegisterWindow Text1.hwnd End SubPrivate Sub Form_Unload(Cancel As Integer) unRegisterWindow Text1.hwnd End Sub
如何屏蔽文本框的右键菜单 作者:江建
在开始之前我们先看一下Windows的工作机制,其实Windows无时无刻都在发送着消息,只是没有相应的程序去响应罢了!比如用户移动或单击了鼠标,或者按下了键盘上的某个键,windows都会发出相应的消息通知窗口。而我们要做的就是扑获Windows所发出的这条消息,然后用VB的 AddressOf 关键字来取代它。 我们这次的目标就是扑获WM_CONTEXTMENU这条消息,它在右击文本框时产生。 程序需要一个窗体、一个文本框,一个标准模块,一个菜单菜单名为mymenu。'模块的代码: 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 LongPublic 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 SubPrivate 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 Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Text1.Enabled = False Text1.Enabled = True PopupMenu mymenu End Sub 搞定简单吧!(^_^) 尽量不要使用 AddressOf 来改变一个窗口的默认窗口函数,VB不擅长做这类的工作。
也可以用有关菜单的api函数,删除右键菜单
就你这个问题就是屏蔽到文本框的环境菜单,当你在文本框点击右键,文本框会得到 WM_CONTEXTMENU消息,然后弹出环境菜单,所以你只要屏蔽掉这个消息,在VB中想重新取得消息的控制权就是用subclass的方法,下面就是例子: 把下面代码粘贴到一个模块: Option Explicit Public Const GWL_WNDPROC As Long = -4 Public Const WM_CONTEXTMENU As Long = &H7B Public defWndProc As Long'used to hold the handle to the combo's edit window Public hwndEdit As LongPublic 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 LongPublic Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As LongPublic Declare Function FindWindowEx Lib "user32" _ Alias "FindWindowExA" _ (ByVal hWnd1 As Long, _ ByVal hWnd2 As Long, _ ByVal lpsz1 As String, _ ByVal lpsz2 As String) As Long Public Sub Hook(hwnd As Long) If defWndProc = 0 Then
defWndProc = SetWindowLong(hwnd, _ GWL_WNDPROC, _ AddressOf WindowProc) End If
End Sub Public Sub UnHook(hwnd As Long) If defWndProc > 0 Then
End Sub Public Function WindowProc(ByVal hwnd As Long, _ ByVal uMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long If hwnd = hwndEdit Then
'watch for the context menu message Select Case uMsg Case WM_CONTEXTMENU
'not the message of interest, 'so process normally WindowProc = CallWindowProc(defWndProc, _ hwnd, _ uMsg, _ wParam, _ lParam) End Select
End If
End Function 窗体中使用: private gHW as long Private Sub Form_Load() gHW = Text1.hwnd Hook gHW End SubPrivate Sub Form_Unload(Cancel As Integer) Unhook gHW End Sub
text1.enable=true
Option Explicit
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 Const WM_RBUTTONDOWN = &H204
Public oldproc As Long
Public Function RegisterWindow(hwnd As Long) As Long
If hwnd <> 0 Then
oldproc = SetWindowLong(hwnd, -4, AddressOf WinProc)
End If
End Function
Public Function unRegisterWindow(hwnd As Long) As Long
If hwnd <> 0 Then
SetWindowLong hwnd, -4, oldproc
End IfEnd Function
Public Function WinProc(ByVal hwnd As Long, ByVal msg As Long, ByVal lpara As Long, ByVal wpara As Long) As LongIf msg = WM_RBUTTONDOWN Then
Exit Function
End IfWinProc = CallWindowProc(oldproc, hwnd, msg, lpara, wpara)
End Function
'窗体
Private Sub Form_Load()
RegisterWindow Text1.hwnd
End SubPrivate Sub Form_Unload(Cancel As Integer)
unRegisterWindow Text1.hwnd
End Sub
作者:江建
在开始之前我们先看一下Windows的工作机制,其实Windows无时无刻都在发送着消息,只是没有相应的程序去响应罢了!比如用户移动或单击了鼠标,或者按下了键盘上的某个键,windows都会发出相应的消息通知窗口。而我们要做的就是扑获Windows所发出的这条消息,然后用VB的 AddressOf 关键字来取代它。
我们这次的目标就是扑获WM_CONTEXTMENU这条消息,它在右击文本框时产生。
程序需要一个窗体、一个文本框,一个标准模块,一个菜单菜单名为mymenu。'模块的代码:
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 LongPublic 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 SubPrivate 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 Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Enabled = False
Text1.Enabled = True
PopupMenu mymenu
End Sub
搞定简单吧!(^_^)
尽量不要使用 AddressOf 来改变一个窗口的默认窗口函数,VB不擅长做这类的工作。
WM_CONTEXTMENU消息,然后弹出环境菜单,所以你只要屏蔽掉这个消息,在VB中想重新取得消息的控制权就是用subclass的方法,下面就是例子:
把下面代码粘贴到一个模块:
Option Explicit
Public Const GWL_WNDPROC As Long = -4
Public Const WM_CONTEXTMENU As Long = &H7B
Public defWndProc As Long'used to hold the handle to the combo's edit window
Public hwndEdit As LongPublic 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 LongPublic Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As LongPublic Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Sub Hook(hwnd As Long) If defWndProc = 0 Then
defWndProc = SetWindowLong(hwnd, _
GWL_WNDPROC, _
AddressOf WindowProc)
End If
End Sub
Public Sub UnHook(hwnd As Long) If defWndProc > 0 Then
Call SetWindowLong(hwnd, GWL_WNDPROC, defWndProc)
defWndProc = 0
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long If hwnd = hwndEdit Then
'watch for the context menu message
Select Case uMsg
Case WM_CONTEXTMENU
‘抓到这个消息,然后用我们自己的事件来代替系统默认的处理事件,比如弹出我们自定义的菜单
WindowProc = 0
' Form1.PopupMenu Form1.mnuPopup
' WindowProc = 0
Case Else
'not the message of interest,
'so process normally
WindowProc = CallWindowProc(defWndProc, _
hwnd, _
uMsg, _
wParam, _
lParam)
End Select
End If
End Function 窗体中使用:
private gHW as long
Private Sub Form_Load()
gHW = Text1.hwnd
Hook gHW
End SubPrivate Sub Form_Unload(Cancel As Integer)
Unhook gHW
End Sub
顺便提一下,如果控件没有HWND属性,可先用SETFOCUS方法,再用GETFOCUS函数得到句柄。