'在form1中录入
Option ExplicitPrivate Sub Form_Load()
Dim long_windowset As Long
Call EnumChildWindows(Me.hwnd, AddressOf EnumFunc, 0&)
'记录原本的Window Procedure的位址
preWinProc = GetWindowLong(hEditWnd, GWL_WNDPROC)
'设定window Procedure到wndproc
long_windowset = SetWindowLong(hEditWnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim long_windowset As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
long_windowset = SetWindowLong(hEditWnd, GWL_WNDPROC, preWinProc)
End Sub
'__________________________________________________
'模块中录入
Option ExplicitPublic Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPublic Const GWL_WNDPROC = (-4)
Private Const WM_RBUTTONDOWN = &H204Public preWinProc As Long
Public hEditWnd As LongPublic Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'以下会截取mouse Rbutton Down
If Msg = WM_RBUTTONDOWN Then
Debug.Print "aaa"
Else
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End If
End Function
Public Function EnumFunc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim ClsName As String
Dim len_clsname As Long
If hwnd = 0 Then
EnumFunc = 0
Else
ClsName = String(255, 0)
len_clsname = GetClassName(hwnd, ClsName, 256)
ClsName = Left(ClsName, len_clsname)
If Left(Trim(LCase(ClsName)), 3) = "thu" Then
hEditWnd = hwnd
EnumFunc = 0
Else
EnumFunc = 1
End If
End If
End Function
'_________
说明在窗口中共有2个控件textbox,codemax,其中textbox的前3位类名为"thu",codemax的前3位类名为"atl",通过上面的语句能去掉textbox控件的右击快捷菜单,却不能去掉codemax控件的右击快捷菜单。
textbox的语句是(If Left(Trim(LCase(ClsName)), 3) = "thu" Then)
codemax的语句是(If Left(Trim(LCase(ClsName)), 3) = "atl" Then)
Option ExplicitPrivate Sub Form_Load()
Dim long_windowset As Long
Call EnumChildWindows(Me.hwnd, AddressOf EnumFunc, 0&)
'记录原本的Window Procedure的位址
preWinProc = GetWindowLong(hEditWnd, GWL_WNDPROC)
'设定window Procedure到wndproc
long_windowset = SetWindowLong(hEditWnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim long_windowset As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
long_windowset = SetWindowLong(hEditWnd, GWL_WNDPROC, preWinProc)
End Sub
'__________________________________________________
'模块中录入
Option ExplicitPublic Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPublic Const GWL_WNDPROC = (-4)
Private Const WM_RBUTTONDOWN = &H204Public preWinProc As Long
Public hEditWnd As LongPublic Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'以下会截取mouse Rbutton Down
If Msg = WM_RBUTTONDOWN Then
Debug.Print "aaa"
Else
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End If
End Function
Public Function EnumFunc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim ClsName As String
Dim len_clsname As Long
If hwnd = 0 Then
EnumFunc = 0
Else
ClsName = String(255, 0)
len_clsname = GetClassName(hwnd, ClsName, 256)
ClsName = Left(ClsName, len_clsname)
If Left(Trim(LCase(ClsName)), 3) = "thu" Then
hEditWnd = hwnd
EnumFunc = 0
Else
EnumFunc = 1
End If
End If
End Function
'_________
说明在窗口中共有2个控件textbox,codemax,其中textbox的前3位类名为"thu",codemax的前3位类名为"atl",通过上面的语句能去掉textbox控件的右击快捷菜单,却不能去掉codemax控件的右击快捷菜单。
textbox的语句是(If Left(Trim(LCase(ClsName)), 3) = "thu" Then)
codemax的语句是(If Left(Trim(LCase(ClsName)), 3) = "atl" Then)
解决方案 »
- 不支持连接表达式
- 一个关于TableDef 的问题?
- 高分求助:请进。。。
- 关于字符串比较的问题
- dim a(100) as byte,怎么把这个数组传给一个函数呢?传地址,函数声明怎么写?
- [求助]一个可以转发网络请求的.so库文件
- SmartMenuXP控件对于中文的支持很不可靠,求救(高手拿分-)
- 为什么我的VB中找不到ActiveX控件接口向导...的菜单?
- 100分紧急问题:请问如何在 VB 中实现“检查软件最新版本的功能”?
- ADO访问加密的ACCESS2000的问题
- 在别的论坛上听说开发c/s系统,vfp比vb更有优势,想在这个版块问一下,兼听则明吗?
- 散分!保留前10条记录的SQL语句
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WH_MOUSE = 7
Public Const WH_KEYBOARD = 2
Public Const WM_RBUTTONDOWN = &H204
Public lngMHook As Long
Public lngKHook As Long'屏蔽鼠标右键功能
Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If idHook < 0 Then
MouseProc = CallNextHookEx(lngMHook, idHook, wParam, ByVal lParam)
Else
Select Case wParam
Case WM_RBUTTONDOWN
MouseProc = 1
Exit Function
Case Else
End Select
MouseProc = CallNextHookEx(lngMHook, idHook, wParam, ByVal lParam)
End If
End Function Function KeydownProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If idHook < 0 Then
KeydownProc = CallNextHookEx(lngKHook, idHook, wParam, ByVal lParam)
Else
Select Case wParam
Case 93
KeydownProc = 1
Exit Function
Case Else
End Select
KeydownProc = CallNextHookEx(lngKHook, idHook, wParam, ByVal lParam)
End If
End Function
窗体:Option ExplicitPrivate Sub Form_Load()
'屏蔽鼠标右键的功能
lngMHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID) '屏蔽键盘中模拟鼠标右键功能的按键
lngKHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeydownProc, App.hInstance, App.ThreadID)
End SubPrivate Sub Form_Unload(Cancel As Integer)
'窗体退出,还原钩子函数
Dim l As Long
If lngMHook Then
l = UnhookWindowsHookEx(lngMHook)
lngMHook = 0
End If
If lngKHook Then
l = UnhookWindowsHookEx(lngKHook)
lngKHook = 0
End If
End Sub
我按你的方法试了一下.
你的回复只能针对textbox,combo等控件屏蔽鼠标右键的功能,却不能对codemax控件屏蔽鼠标右键的功能.