prevent paste into textbox

[jsun9]

any ideas how I could prevent someone from pasting text into a textbox?

[Sastraxi]

Use .Locked = True, or on the OnClick event, clear the clipboard. But .Locked will not let you type, and OnClick will clear images and stuff too.

[Dbee]

I Ran Across this routine somewhere and I will turn of all pasteing and copying in a text box.

But as you will find out it has its limits.

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
   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_RBUTTONUP = &H205
   Public Const WM_NCDESTROY = &H82
   Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Dim txtcontrol As Object
    Set txtcontrol = GetControlFromhWnd(hWnd)
    If TypeOf txtcontrol Is TextBox Then
     If Msg <> WM_RBUTTONUP Then
      WndProc = CallWindowProc(CLng(txtcontrol.Tag), hWnd, Msg, wParam, lParam)
     Else
      'Put custom menu here
      'eg.
      'form1.PopUpMenu form1.mnupopup
      WndProc = 0
     End If
    If Msg = WM_NCDESTROY Then UnHookWindow (txtcontrol)
   Else
    'oops
    WndProc = 0
   End If
   End Function
   Public Function GetControlFromhWnd(hWnd As Long) As Object
   'Parameters: hWnd - Window Handle to object
   'Returns: Object reference to cotrol with the hwnd
   'Note this will not return forms
   Dim frm As Form
   Dim ctl As Control
   For Each frm In Forms
   For Each ctl In frm.Controls
    If ctl.hWnd = hWnd Then
    Set GetControlFromhWnd = ctl
    Exit Function
    End If
   Next
   Next
  ' Beep
   End Function
   Public Sub HookWindow(hookobject As TextBox)
    If hookobject.Tag <> "" Then Exit Sub
    'remember old window handler
    hookobject.Tag = CStr(GetWindowLong(hookobject.hWnd, GWL_WNDPROC))
    'install old window handler
    Call SetWindowLong(hookobject.hWnd, GWL_WNDPROC, AddressOf WndProc)
   End Sub
   Public Sub UnHookWindow(hookobject As TextBox)
    'if no old window handler remembered - nothing to replace current one with
    If hookobject.Tag = "" Then Exit Sub
    'replace ole window handler
    Call SetWindowLong(hookobject.hWnd, GWL_WNDPROC, CLng(hookobject.Tag))
    hookobject.Tag = ""
   End Sub

Put all of This in too a mobule.

[crptcblade]

Dbee, your code is a bit mashed together, so I honestly can't tell if this is the same, but...

'In a form
Option Explicit
 
Private Sub Form_Load()
    Call Hook(Text1.hWnd)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Call Unhook(Text1.hWnd)
End Sub
 
 
'In a module
Option Explicit
 
Private 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 Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, _
                                                                            ByVal wMsg As Long, _
                                                                            ByVal wParam As Long, _
                                                                            ByVal lParam As Long) _
                                                                            As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_PASTE = &H302
 
Private mPrevProc As Long
 
Public Function TextWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
 
    If uMsg = WM_PASTE Then
        TextWndProc = 0&
        Exit Function
    End If
 
    If mPrevProc > 0 Then
        TextWndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)
    Else
        TextWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
    End If
 
End Function
 
Public Sub Hook(hWnd As Long)
    mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf TextWndProc)
End Sub
 
Public Sub Unhook(hWnd As Long)
    
    Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)
    mPrevProc = 0&
    
End Sub

[Dbee]

I used hook textbox as a call for the textbox I was using and you will have to call it for every one you use.

An yes the code is to compacked sorry for that your last post is correct except you call it for the text boxes only. not the entire form.

The trouble I had with it if i had more than one form loaded then the form that lost focus would go blank on me. Screwed up the non focus forms.

If you are using one form only then it works like a charm.

[DiGiTaIErRoR]

On the keypress event:

if keyascii = 22 then
'ctrl+v pressed
keyascii = 0
end if

[crptcblade]

Originally posted by DiGiTaIErRoR
On the keypress event:

if keyascii = 22 then
'ctrl+v pressed
keyascii = 0
end if

What about pasting from the context menu?

[DiGiTaIErRoR]

In a RTB you can turn off the autoverb menu.

Or subclass a textbox and intercept the mousedown event.

You'll have fun with that.

[crptcblade]

Or you can use the code a few posts up.

[DiGiTaIErRoR]

Originally posted by crptcblade
Or you can use the code a few posts up.

But if he wants a simple solution, and is using a RTB, my code would work best.

[jsun9]

awesome, thanks for you help!