by E Benfield (1 Submission)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 26th April 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Validates keystrokes for an object's KeyPress event
API Declarations
'Feel free to use this code freely. If you make enhancements, share them.
'This code does multiple things:
'1. It validates a keystroke based on the ValidChars or InvalidChars, and cancels the keystroke entirely if invalid (sets KeyAscii to 0, which is passed by reference)
'2. If KeyAscii is vbKeyReturn (ENTER key), it swaps the keystroke for a {TAB} action (tabs to the next field, great for 10-key apps)
'3. The PurgeText routine will clean up a string based on the ValidChar or InvalidChar set (necessary if the user pastes a string into a restricted field, which bypasses the check on individual keystrokes)
Global Const InvalidChar_WINFILESYSTEM = "/*?<>|""" 'series of " adds Chr$(34) to the string
Global Const InvalidChar_WINFILENAME = "/\:*?<>|""" 'series of " adds Chr$(34) to the string
Global Const ValidChar_NUMERIC = "1234567890.-"
Global Const ValidChar_NUMERICWHOLE = "1234567890-" '(no decimal)
VBcoders
Optional InvalidChar As String = "", Optional AllowCtrlCodes As Boolean = True) As Boolean
Dim vkPASS As Boolean
vkPASS = True
If KeyAscii < 27 Then
If KeyAscii = vbKeyReturn Then
KeyAscii = 0 'cancel the ENTER keypress
Call SendKeys("{TAB}") 'send TAB in its place
Else
'ASCII 1-26 = ctrl+A to ctrl+Z
If Not AllowCtrlCodes Then
'NOTE: This can cancel Copy, Cut and Paste functionality!
KeyAscii = 0
vbPASS = False
End If
End If
Else
'Check if the character exists in the ValidChars string
If ValidChars <> "" Then
If InStr(1, ValidChars, Chr$(KeyAscii)) = 0 Then
KeyAscii = 0
vkPASS = False
End If
ElseIf InvalidChar <> "" Then
If InStr(1, InvalidChar, Chr$(KeyAscii)) > 0 Then
KeyAscii = 0
vkPASS = False
End If
End If
End If
ValidateKeystroke = vkPASS
End Function
Public Function ValidateKeyPurgeText(ByVal TextValue As String, Optional ValidChars As String = "", _
Optional InvalidChar As String = "", Optional AllowCtrlCodes As Boolean = False, _
Optional AllowNewLine As Boolean = True) As String
Dim vkRTN As String
vkRTN = ""
Dim vkT As Long
Dim vkSEG As String
For vkT = 1 To Len(TextValue)
vkSEG = Mid(TextValue, vkT, 1)
If Asc(vkSEG) < 27 Then
If Asc(vkSEG) = 10 Or Asc(vkSEG) = 13 Then
'10 and 13 are Line Feed and Carriage Return... New Line!
If AllowNewLine = False Then vkSEG = ""
Else
If AllowCtrlCodes = False Then vkSEG = ""
End If
Else
If ValidChars <> "" Then
'Check if the character exists in the ValidChars string
If InStr(1, ValidChars, vkSEG) = 0 Then
vkSEG = ""
End If
ElseIf InvalidChar <> "" Then
'Check if the character exists in the InvalidChars string
If InStr(1, InvalidChar, vkSEG) > 0 Then
vkSEG = ""
End If
End If
End If
vkRTN = vkRTN & vkSEG
Next vkT
ValidateKeyPurgeText = vkRTN
End Function
