'' **filtro caratteri***
'' ***
'' da inserire in un keypress
'' ***
'' **ARGOMENTI:**
'' - stringa: il testo della text box da controllare
'' da inserire!!
Public Function Filtro(stringa As String)
If key.Text Like "[^0-9.,-e]" Then
Stop Event
Endif
If Key.Text = "." Then
If ricerca(stringa, ".") = 1 Then
Stop Event
Endif
Endif
If Key.Text = "-" Then
If ricerca(stringa, "-") = 1 Then
Stop Event
Endif
Endif
If Key.Text = "," Then
If ricerca(stringa, ".") = 1 Then
Stop Event
Endif
Endif
If Key.Text = "e" Then
If ricerca(stringa, "e") = 1 Then
Stop Event
Endif
Endif
If Not IsAscii(Key.Text) Then
Select Case Key.Text
Case Not ""
Stop Event
End Select
Endif
End
'' **controllo totale***
'' ***
'' da inserire nel change
'' ***
'' **ARGOMENTI:**
'' - stringa: il testo della textbox da controllare
''
'' **RITORNA:**
'' - la stringa corretta
''
'' -------attenzione---------
''
'' funziona solo con il primo carattere
Public Function controllochange(stringa As String) As String
Dim lettera, ls, rs, lstring As String
Dim l As Integer
lettera = Right(stringa, 1)
If lettera <> "" Then
Select Case lettera
Case "0" To "9" '''''''''''
lettera = lettera
Case ","
If (ricerca(stringa, ".") = 0) And Len(stringa) >= 1 Then
lettera = "." ''''''''''''caratteri consentiti
Else
lettera = ""
Endif
Case "."
If ricerca(stringa, ".") = 1 Then
lettera = "."
Else
lettera = ""
Endif
Case "-"
If InStr(stringa, "-") = 1 And ricerca(stringa, "-") = 1 Then
lettera = "-"
Else
lettera = ""
Endif
Case "e"
lettera = "e"
Case Else ''''''''''''''''''''''''''''''''''''''''''''''''
lettera = ""
End Select
stringa = Left(stringa, Len(stringa) - 1) & lettera
Endif
If Left(stringa, 1) = "." Then
stringa = Right(stringa, Len(stringa) - 1)
Endif
If ricerca(stringa, "-") = 1 Then
If Not (InStr(stringa, "-") = 1) Then
stringa = Replace(stringa, "-", "")
Endif
Endif
If ricerca(stringa, ",") = 1 Then
stringa = Replace(stringa, ",", ".")
Endif
For l = 1 To Len(stringa) ''''''parte copia incolla
Select Case Mid(stringa, l, 1)
Case "0" To "9", ".", ",", "e", "-"
stringa = stringa
Case Else
stringa = Replace(stringa, Mid(stringa, l, 1), "")
End Select
Next
Return stringa
End ''''''''''''''''''''''''''''''''''''''''''''''''''
'' **ricerca il numero di caratteri in una stringa***
'' ***
'' **ARGOMENTI:**
'' - testo: il testo in cui cercare
'' -lettera: la lettera da cercare
''
'' **RITORNA:**
'' - il numero di caratteri trovati
Public Function ricerca(testo As String, lettera As String) As Integer
Dim l, trovato As Integer
For l = 1 To Len(testo)
' Se il carattere controllato è uguale a quello che si sta cercando....
If Mid(testo, l, 1) = lettera Then
'...allora incrementa di un'unità il valore della variabile integer che tiene il conto:
Inc trovato
Endif
Next
Return trovato
End
più o meno è questa...
