方法1：在文本框获得焦点的时候清空剪贴板 即在文本得到焦点clipboard.Clear 方法2：子类化拦截消息 拦截代码1 复制粘贴用的是WM_COPY, WM_PASTE两个消息，可以直接子类化拦截 新建一工程,在默认窗体上放一个文本框,名称不改,Text1: Option Explicit Private Sub Form_Load() PrevWndProc = SetWindowLong(Text1.Hwnd, GWL_WNDPROC, AddressOf SubWndProc) End Sub Private Sub Form_Unload(Cancel As Integer) SetWindowLong Text1.Hwnd, GWL_WNDPROC, PrevWndProc End Sub 窗体代码OK.然后新建一个标准模块,放以下代码进去: 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 GWL_WNDPROC = (-4) Public Const WM_GETTEXT = &HD Public Const WM_COPY As Long = &H301 Public Const WM_PASTE As Long = &H302 Public PrevWndProc As Long Public Function SubWndProc(ByVal Hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case MSG '在这里进行过滤.如果知道其他的消息,也可以在这里过滤. Case WM_COPY, WM_PASTE, WM_CUT '过率复制、粘贴、剪切消息 SubWndProc = 1 Exit Function End Select SubWndProc = CallWindowProc(PrevWndProc, Hwnd, MSG, wParam, lParam) '其它消息不管 End Function 拦截代码2 子类化拦截WM_COPY, WM_PASTE Public Function CheckText(KeyIn As Integer, InValidateString As String, NY As Boolean, Editable As Boolean) As Integer '输入过滤 'KeyIn 是KeyAscii值 'InValidateString 字符列表 'NY true ：只能输入InValidateString中的字符 ' False：只能输入InValidateString中的没有的字符 'Editable 只否可以使用编辑键 On Error GoTo myerr Dim ValidateList As String Dim KeyOut As Integer If KeyIn < 0 Then CheckText = 0 Beep Exit Function End If If Editable = True Then ValidateList = UCase(InValidateString) & Chr(8) Else ValidateList = UCase(InValidateString) End If If NY Then If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then KeyOut = KeyIn Else KeyOut = 0 Beep End If Else If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) = 0 Then KeyOut = KeyIn Else KeyOut = 0 Beep End If End If CheckText = KeyOut Exit Function myerr: End Function Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = CheckText(KeyAscii, "1234567890", True, True) '或 KeyAscii = CheckText(KeyAscii, "1234567890",False , False) End Sub 拦截代码4 一个模块,一个窗体: 模块代码: Option Explicit 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 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 Const WM_PASTE = &H302 Public Const GWL_STYLE = (-16) Public Const ES_NUMBER = &H2000 Private Const GWL_WNDPROC = (-4) Dim OldWndProc As Long Public Sub StartSubclass(ByVal hwnd As Long) OldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubClassProc) End Sub Public Sub EndSubclass(ByVal hwnd As Long) If OldWndProc <> 0 Then Call SetWindowLong(hwnd, GWL_WNDPROC, OldWndProc) OldWndProc = 0 End If End Sub Private Function SubClassProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case wMsg Case WM_PASTE Debug.Print "吃掉了WM_PASTE消息" Case Else SubClassProc = CallWindowProc(OldWndProc, hwnd, wMsg, wParam, lParam) End Select End Function 窗体(有一个textbox)代码: Option Explicit Private Sub Form_Load() Dim style As Long style = GetWindowLong(Text1.hwnd, GWL_STYLE) style = style Or ES_NUMBER SetWindowLong Text1.hwnd, GWL_STYLE, style text1.text="" StartSubclass Text1.hwnd End Sub Private Sub Form_Unload(Cancel As Integer) EndSubclass Text1.hwnd End Sub 方法3：对文本框设置键盘HOOK 代码如下： ' '本段代码原作者 Modest(塞北雪貂) ' '阿勇略添加一点点代码 Option Explicit '判断函数调用时指定虚拟键的状态 '获得拥有输入焦点的窗口的句柄 Public Declare Function GetFocus Lib "user32 " () As Long Public Declare Function GetAsyncKeyState Lib "user32 " (ByVal vKey As Long) As Integer Public 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 Const VK_CONTROL As Integer = &H11 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 GetFocus <> Form1.Text1.hwnd Then Exit Function 'Form1.Text1.hwnd换成你想控制的textbox 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 GetFocus <> Form1.Text1.hwnd Then Exit Function 'Form1.Text1.hwnd换成你想控制的textbox If idHook < 0 Then KeydownProc = CallNextHookEx(lngKHook, idHook, wParam, ByVal lParam) Else Debug.Print wParam, lParam Select Case wParam Case 93 '屏蔽键盘右键功能 KeydownProc = 1 Exit Function Case vbKeyV If GetAsyncKeyState(VK_CONTROL) Then KeydownProc = 1 Exit Function End If Case Else End Select KeydownProc = CallNextHookEx(lngKHook, idHook, wParam, ByVal lParam) End If End Function 窗口中代码 Private Sub Form_Load() '屏蔽鼠标右键的功能 lngMHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID) '屏蔽键盘中模拟鼠标右键功能的按键 lngKHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeydownProc, App.hInstance, App.ThreadID) End Sub Private 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 方法4： 檢測到昰右鍵, 使用sendkeys Private Sub txtUserNo_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then SendKeys "{Tab}" KeyAscii = 0 End If End Sub
转载于:https://www.cnblogs.com/feima-lxl/archive/2008/05/03/1180497.html
相关资源：数据结构—成绩单生成器