如何屏蔽text控件的鼠标右键功能,即在text中点击右键或者ctrl+c,ctrl+x没反应?

解决方案 »

  1.   

    试试这个:
    标准模块代码:
    Option ExplicitPublic OldWindowProc As LongDeclare 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 LongPublic Const GWL_WNDPROC = (-4)Private Const WM_CONTEXTMENU = &H7B
    Private Const WM_PASTE = &H302
    Public Function NewWindowProc(ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If (msg <> WM_PASTE) And (msg <> WM_CONTEXTMENU) Then
            NewWindowProc = CallWindowProc( _
                OldWindowProc, hWnd, msg, wParam, _
                lParam)
        End If
    End Function
    '------------------------------------------------
    '窗体代码:
    Option ExplicitPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Const GWL_STYLE = (-16)
    Private Const ES_NUMBER = &H2000Private Sub Form_Load()
        Dim style As Long
        style = GetWindowLong(Text1.hWnd, GWL_STYLE)    OldWindowProc = SetWindowLong( _
            Text1.hWnd, GWL_WNDPROC, _
            AddressOf NewWindowProc)
    End SubPrivate Sub Form_Unload(Cancel As Integer)
        SetWindowLong Text1.hWnd, GWL_WNDPROC, OldWindowProc
    End Sub
      

  2.   

    太多人问了.
    LZ在CSDN上搜一下吧.大把答案.要学会搜索
      

  3.   

    呵呵,tztz520(午夜逛街) 说得不错,自己先在论坛上找,找不到再出贴,可以加深印象。其实像这种基本问题,论坛上都可以搜到,比如说此问题,
    社区中点击全文搜索--〉选择论坛--〉条件中输入"text控件,屏蔽右键"--〉论坛类型中选择
    VB--〉则出现若干帖子供你参考...
      

  4.   

    tztz520(午夜逛街)说得对,要学会找到解决问题的方式。
      

  5.   

    下面的代码已经在我的程序中使用,不过相关api请自行添加:
    Public Sub Hook(ByVal hwnd As Long) ''''''''''安装钩子
        prevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
    End Sub
    Public Sub UnHook(ByVal hwnd As Long)  '''''''''''卸载钩子
        If prevProc <> GetWindowLong(hwnd, GWL_WNDPROC) Then
           Call SetWindowLong(hwnd, GWL_WNDPROC, prevProc)
        End If
    End Sub
    '--------------------------处理鼠标右键消息
    Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wp As Long, ByVal lp As Long) As Long
        Select Case uMsg
            Case WM_RBUTTONDOWN
                 Form1.PopupMenu Form1.bbj, 2  ‘ 弹出form1窗体中的bbj菜单
            Case Else
                WndProc = CallWindowProc(prevProc, hwnd, uMsg, wp, lp)
                Exit Function
        End Select
        WndProc = True
    End Function''''''''''''''''''''检查组件是否为Text2组件
    Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
          If GetClsName(hwnd) = "ThunderRT6TextBox" Then
            flaHwnd = hwnd
            Hook flaHwnd
            EnumChildProc = 0
        Else
            EnumChildProc = 1
        End If
    End Function
    ''''''''''''''''''''''''''''''''''''枚举Text2组件
    Public Function GetClsName(ByVal hwnd As Long) As String
        Dim xLen As Long
        Dim sBuffer As String
        Dim S, d As String
        
        sBuffer = String(255, 0)
        sBuffer = String(255, 0)
        xLen = GetClassName(hwnd, sBuffer, 255)
        If xLen = 0 Then
            GetClsName = ""
        Else
            GetClsName = Left(sBuffer, xLen)
        End If
    End Function