'在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)

解决方案 »

  1.   

    模块:Option ExplicitPublic Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    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
      

  2.   

    题目:去掉控件的右击快捷菜单? 
        我按你的方法试了一下.
        你的回复只能针对textbox,combo等控件屏蔽鼠标右键的功能,却不能对codemax控件屏蔽鼠标右键的功能.