by Raghuraja.C (12 Submissions)
Category: Custom Controls/Forms/Menus
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Originally Published: Fri 3rd January 2003
Date Added: Mon 8th February 2021
Rating:
(1 Votes)
Some Simple Validations like Checking Printer, Alpha, Numeric and Alpha Numeric etc
'and Alpha Numeric etc
'Please Copy and Paste the following code and use it
'=<>=<>=<>=<>=< To Check Printer Installed or Not >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnCheckPrinter() As Boolean
On Error GoTo LocalErrorHandler
fcnCheckPrinter = False
If Printer.DeviceName = "" Then
Else
fcnCheckPrinter = True
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=< To center called window on the screen >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Sub proAdjWin2Center(Window2Center As Object, Optional intOption As Integer)
On Error GoTo LocalErrorHandler
If intOption = 1 Then
Window2Center.Top = ((Screen.Height) - Window2Center.Height) / 2
Window2Center.Left = (Screen.Width - Window2Center.Width) / 2
Else
Window2Center.Top = (frmMain.ScaleHeight - Window2Center.ScaleHeight - frmMain.tlbMain.Height) / 2
Window2Center.Left = (frmMain.ScaleWidth - Window2Center.ScaleWidth - frmMain.tlbMain.Height) / 2
End If
LocalErrorHandler:
End Sub
'=<>=<>=<>=< Returns only Numbers like 0,1,2 .. 9 >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnValidateNumeric(strCheckChr As Integer) As Boolean
On Error GoTo LocalErrorHandler
fcnValidateNumeric = False
If (strCheckChr >= 48 And strCheckChr <= 57) Or strCheckChr = 8 Then
fcnValidateNumeric = True
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=< Allows only Numbers like 0,1,2 .. 9 >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnReturnValidNumber(strCheckChr As Integer) As Integer
On Error GoTo LocalErrorHandler
fcnReturnValidNumber = 0
If (strCheckChr >= 48 And strCheckChr <= 57) Or strCheckChr = 8 Then
fcnReturnValidNumber = strCheckChr
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=< Allows only Currency like 0.00, 1.00, .. 9.00 >=<>=<>=<>=<>
Public Function fcnValidCurrency(str2Use As TextBox, str2Chk As Integer) As Integer
On Error GoTo LocalErrorHandler
If str2Chk = 8 Then
Exit Function
End If
If InStr(1, str2Use.Text, ".") <> 0 And str2Chk = 46 Then
'KeyAscii = 0
fcnValidCurrency = 0
End If
If InStr(1, str2Use.Text, ".") <> 0 Then
If Len(Mid(str2Use.Text, (InStr(1, str2Use.Text, ".") + 1))) >= 2 And str2Use.SelStart >= InStr(1, str2Use.Text, ".") Then
'KeyAscii = 0
fcnValidCurrency = 0
End If
End If
If str2Chk = 46 Then Exit Function
If Not fcnValidateNumeric(str2Chk) Then
'KeyAscii = 0
fcnValidCurrency = 0
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=< Allows only Characters like a,b ... z, A,B ... Z >=<>=<>=<>=<>=
Public Function fcnValidateChar(strCheckChr As String) As Boolean
On Error GoTo LocalErrorHandler
fcnValidateChar = False
If (strCheckChr >= 65 And strCheckChr <= 90) And _
(strCheckChr >= 97 And strCheckChr <= 122) Or _
(strCheckChr = 8) Then
fcnValidateChar = True
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=< Allows only Alpha Numeric like 0,1,2, ... 9,a,b ... z, A,B ... Z >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnValidateAlphaNumeric(strCheckChr As String) As Boolean
On Error GoTo LocalErrorHandler
fcnValidateAlphaNumeric = False
If (strCheckChr >= 48 And strCheckChr <= 57) And _
(strCheckChr >= 65 And strCheckChr <= 90) And _
(strCheckChr >= 97 And strCheckChr <= 122) Or _
(strCheckChr = 8) Then
fcnValidateAlphaNumeric = True
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< Checking Valid Date like 01/01/2003 >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnValidDate(strDate2Check As Date) As Boolean
On Error GoTo LocalErrorHandler
fcnValidDate = False
If CDate(strDate2Check) Then
fcnValidDate = True
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< Convert Date >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnConvertDate(str2Convert As String) As Date
On Error GoTo LocalErrorHandler
fcnConvertDate = Format(str2Convert, "MM/DD/YYYY")
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< Checking Valid Time like 01:01:00 AM >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnValidateTime(str2Convert As String) As Boolean
On Error GoTo LocalErrorHandler
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< Checking Valid Telephone Number >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnValidateTel(TelNo As Double) As String
On Error GoTo LocalErrorHandler
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< Triming the Value Removing space from input >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnTrimValue(str2Trim As String) As String
On Error GoTo LocalErrorHandler
fcnTrimValue = Trim(str2Trim)
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To format value like Date, Currency etc >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnFormat(str2BeFormat As Variant, Optional strOpt As String) As Variant
On Error GoTo LocalErrorHandler
Select Case UCase(strOpt)
Case "C" 'Currency
fcnFormat = Format$(str2BeFormat, "$#,##0.00")
Case "D" 'Date
fcnFormat = Format$(str2BeFormat, "MM/DD/YYYY")
Case "T" 'Time
fcnFormat = Format$(str2BeFormat, "HH:MM:SS AMPM")
Case "N" 'Numberic
fcnFormat = Format$(str2BeFormat, "#")
Case "L" 'Convert into Lower Case
fcnFormat = Format$(str2BeFormat, "<")
Case "U" 'Convert into Upper Case
fcnFormat = Format$(str2BeFormat, ">")
Case Else 'Other
fcnFormat = Format$(str2BeFormat)
End Select
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To get the value >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnGetVal(strVal As Variant) As Variant
On Error GoTo LocalErrorHandler
If Trim(strVal) = "" Or IsNull(Trim(strVal)) Then
fcnGetVal = 0
Else
fcnGetVal = strVal
End If
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To decrept the required String >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnDecrptString(valToDecrpt As String) As String
On Error GoTo LocalErrorHandler
Dim strOriVal As String
Dim strDeCry As String
Dim intInc As Integer
Dim rndVal1 As Integer
Dim rndVal2 As Integer
strOriVal = valToDecrpt
rndVal1 = Asc(Left(strOriVal, 1))
rndVal2 = Asc(Right(strOriVal, 1))
strOriVal = Mid(strOriVal, 2, Len(strOriVal) - 2)
For intInc = 1 To Len(strOriVal)
strDeCry = Chr(Asc(Mid(strOriVal, intInc, 1)) - rndVal1 + rndVal2) & strDeCry
Next
fcnDecrptString = strDeCry
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To encrypt the required String >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnEncryptString(valToEncrpt As String) As String
On Error GoTo LocalErrorHandler
Dim strOriVal As String
Dim intEnCry As String
Dim intInc As Integer
Dim rndVal1 As Integer
Dim rndVal2 As Integer
strOriVal = valToEncrpt
rndVal1 = Round(Rnd(9) * 10)
rndVal2 = Round(Rnd(9) * 5)
If rndVal1 = 0 Then
rndVal1 = 4
End If
For intInc = 1 To Len(strOriVal)
intEnCry = Chr(Asc(Mid(strOriVal, intInc, 1)) + rndVal1 - rndVal2) & intEnCry
Next
fcnEncryptString = Chr(rndVal1) & intEnCry & Chr(rndVal2)
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To Replace if string contants single code >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnReplaceSingleQuote(strChk2Convert As String) As String
On Error GoTo LocalErrorHandler
Dim strReplaced As String
Dim intQuotePos As Integer
fcnReplaceSingleQuote = ""
strReplaced = strChk2Convert
intQuotePos = InStr(strReplaced, "'")
Do While intQuotePos > 0
strReplaced = Left(strReplaced, intQuotePos - 1) & _
Chr(146) & _
Mid(strReplaced, intQuotePos + 1)
intQuotePos = InStr(intQuotePos + 2, strReplaced, "'")
Loop
fcnReplaceSingleQuote = strReplaced
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To convert date to String as MM/DD/YYYY format >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnDate2String(Date2Use As Date) As String
On Error GoTo LocalErrorHandler
fcnDate2String = CStr(Date2Use)
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To Check data is Valid or Not >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnDateIsInvalid(strDate) As Boolean
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To Find a char int the String >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnFindChrInString(strString As String, strChar2Find As String) As Double
On Error GoTo LocalErrorHandler
Dim dblReturn As Double
fcnFindChrInString = 0
dblReturn = InStr(1, strString, strChar2Find, vbTextCompare)
If dblReturn = 0 Then 'Not Found
Else 'Found
fcnFindChrInString = dblReturn
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To Find a char and if found Replace >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Function fcnReplaceChrInString(strString, strChar2Find, strChar2Replace) As String
On Error GoTo LocalErrorHandler
Dim dblReturn As Double
fcnReplaceChrInString = 0
dblReturn = InStr(1, strString, strChar2Find, vbTextCompare)
If dblReturn = 0 Then 'Not Found
Else 'Found
fcnReplaceChrInString = Left(strString, dblReturn - 1)
fcnReplaceChrInString = fcnReplaceChrInString & strChar2Replace
fcnReplaceChrInString = fcnReplaceChrInString & Right(strString, dblReturn + 1)
End If
Exit Function
LocalErrorHandler:
End Function
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< To display Unknown Error >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
Public Sub proUnknownError(strErrorContext As String)
Screen.MousePointer = StandardArrow
Dim strMsg As String
strMsg = "The following error has occurred:" & Chr(13) & Chr(13)
strMsg = strMsg & "Number: " & Err.Number & Chr(13)
strMsg = strMsg & "Description: " & Err.Description & Chr(13)
strMsg = strMsg & "Context: " & strErrorContext
MsgBox strMsg, vbCritical, "Error"
End Sub
'=<>=<>=<>=<>=<>=<>=<>=<>=<>=< End of Validations >=<>=<>=<>=<>=<>=<>=<>=<>=<>=
No comments have been posted about Some Simple Validations like Checking Printer, Alpha, Numeric and Alpha Numeric etc. Why not be the first to post a comment about Some Simple Validations like Checking Printer, Alpha, Numeric and Alpha Numeric etc.