VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



CheckKeypress

by Martin Idman (6 Submissions)
Category: VB function enhancement
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Date Added: Wed 3rd February 2021
Rating: (4 Votes)

Inputs
KeyAscii from controls keypress-event cAllowed as a string ("N" for numbers only...)
Assumes
Put the call in a controls keypress-event Ex: KeyAscii=CheckKeypress(KeyAscii, "N") Will only allow the user to enter digits in a control
Code Returns
KeyAscii for pressed key if ok or nothing and a beep for not ok
API Declarations

Rate CheckKeypress

Public Function CheckKeyPress(iKeyIn As Integer, cAllowed As String) As Integer
  Dim cValidKeys As String
  Select Case cAllowed
   Case "N" ' Just numbers
     cValidKeys = "1234567890" & vbCr & vbTab & vbBack
   Case "N1" ' Decimal numbers
     cValidKeys = "1234567890," & vbCr & vbTab & vbBack
   Case "N2" ' Simple math
     cValidKeys = "1234567890+-*/=," & vbCr & vbTab & vbBack
   Case "C" ' Simple characterset(I'm Swedish, hence some strange ones)
     cValidKeys = "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖAAÉEÜI- " & vbCr & vbTab & vbBack
   Case "C1" ' Enhanced characterset
     cValidKeys = "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖAAÉEÜI&#,.-/\+-*%$<>:;@!?=() " & vbCr & vbTab & vbBack
   Case "C2" ' Enhanced + digits
     cValidKeys = "ABCDEFGHIJKLMNOPQRSTUVWXYZÅÄÖAAÉEÜI1234567890½&#,.-/\+-*%$<>:;@!?=() " & vbCr & vbTab & vbBack
   Case "M" ' Mail and WWW
     cValidKeys = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_/\~:@." & vbCr & vbTab & vbBack
   Case "D" ' Date or telephonenumbers
     cValidKeys = "0123456789-" & vbCr & vbTab & vbBack
  End Select
  If InStr(cValidKeys, UCase(Chr(iKeyIn))) Then
     CheckKeyPress = iKeyIn
  Else
   Beep
   CheckKeyPress = 0
  End If
End Function

Download this snippet    Add to My Saved Code

CheckKeypress Comments

No comments have been posted about CheckKeypress. Why not be the first to post a comment about CheckKeypress.

Post your comment

Subject:
Message:
0/1000 characters