试试这个: 标准模块代码: 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
下面的代码已经在我的程序中使用,不过相关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
标准模块代码:
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
LZ在CSDN上搜一下吧.大把答案.要学会搜索
社区中点击全文搜索--〉选择论坛--〉条件中输入"text控件,屏蔽右键"--〉论坛类型中选择
VB--〉则出现若干帖子供你参考...
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