VB中怎么禁止在文本框中粘贴文本,而必须手工输入?
我想禁止操作者在文本框中粘贴文本,要求他们必须手工输入,怎么实现呢?
[解决办法]
有个变通得方法：在文本框获得焦点的时候清空剪贴板。
[解决办法]
在文本得到焦点clipboard.Clear 这样可以做到
[解决办法]
处理消息可能做到
[解决办法]
子类化
[解决办法]
对文本框设置键盘HOOK,过滤掉ctrl+V
将text的右键菜单禁了
[解决办法]
' '本段代码原作者 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
[解决办法]
感觉HOOK键盘不理想....没有从根源解决问题..
于是就拆了一个文本框来看看.....发现复制粘贴用的是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
SubWndProc = 1
Exit Function
End Select
SubWndProc = CallWindowProc(PrevWndProc, Hwnd, MSG, wParam, lParam) '其它消息不管
End Function
完成后F5看看.....你还能不能在那个文本框里复制粘贴.......
[解决办法]
晕倒,这里不结帖,我找这个帖子时好辛苦.................
还是自己复制下来算了-_-b
