Le varie funzioni della Classe terminano tutte con Return ValoreFormattatoPossono terminare anche con più valori, contenuti in un vettore, per esempio.
... contenuti in un vettore...e, qualora il vettore venga creato nella routine chiamante, la funzione chiamata non avrà bisogno della parola-chiave "Return", poiché il passaggio del vettore, come parametro, avviene per "Indirizzo".
Public Sub FormatVal2(stringa As String) As String '' Formattazione a due decimali e inserimento separatore migliaia
....
codice
....
Return stringa
End
Private FrmValori As New CFormatValori
Public Sub TextBox1_Activate()
TextBox1.Text = FrmValori.FormatVal2(TextBox1.Text)
End
Possono terminare anche con più valori, contenuti in un vettore, per esempio.
:ciao:
Public Sub TextBox1_Change()
myChange(TextBox1)
End
Public Sub TextBox1_KeyPress()
myPress(TextBox1)
End
Private Sub myChange(hBox As TextBox)
Dim c As String, i As Integer
c = hBox.Text
i = hBox.Pos
If Asc(c, i) > 47 And Asc(c, i) < 58 Then
Else If Asc(c, i) = 45 Then
If i > 1 Then
If Asc(c, i - 1) = 45 Then
hBox.text = Mid(c, 1, Len(c) - 1)
Endif
Endif
Else If Asc(c, i) = 44 Or If Asc(c, i) = 46 Then
If i > 1 Then
If Asc(c, i - 1) = 44 Or If Asc(c, i - 1) = 45 Or If Asc(c, i - 1) = 46 Then
hBox.text = Mid(c, 1, Len(c) - 1)
Endif
Else
hBox.Clear()
Endif
Else
hBox.text = Mid(c, 1, Len(c) - 1)
Endif
End
Private Sub myPress(hBox As TextBox)
Dim s As String
If Key.Code = Key.Return Or Key.Code = Key.Tab Then
If IsNull(hBox.Text) Then Return
s = ControlloValore(hBox.Text)
If s <> "ERRORE INATTESO" Then
hBox.Text = s
Else
Message.Warning(s, "OK")
Stop Event
hBox.Clear()
hBox.SetFocus()
Endif
Endif
End
Private Function ControlloValore(value As String) As String
Dim f As Float
'Print value
Try f = CFloat(Val(value))
If Error Then Return "ERRORE INATTESO"
'Print Val(value)
Return Format(Val(value), ",#.#0")
EndReturn Trim(Format(Val(value), "-,#.#0"))..rubare l'idea? ... di usare un vettore? Ammetto che l'idea è talmente geniale che solo io potevo averla! :P :P :PPossono terminare anche con più valori, contenuti in un vettore, per esempio.
:ciao:
Purtroppo il forum è diventato meno gentile e non avvisa più se altri hanno già risposto mentre stai scrivendo, poi la premura... .
Scusa :-* non volevo rubarti l'idea.
per ...osmosi! :P
:ciao:
...In questo modo mi costringi in ogni Form nel quale mi serve utilizzare questi controlli/formattazione dei valori
Comunque ripensando al problema di Tornu io lo affronterei così:
...
In questo modo mi costringi in ogni Form ... ripetere le stesse routine...
Public Function myChange(char As String, pos As Integer) As String
Dim c, sText As String, i As Integer
'Stop
c = char
i = pos
If Asc(c, i) > 47 And Asc(c, i) < 58 Then
sText = c
Else If Asc(c, i) = 45 Then
If i > 1 Then
If Asc(c, i - 1) = 45 Then
sText = Mid(c, 1, Len(c) - 1)
Else
sText = c
Endif
Else
sText = c
Endif
Else If Asc(c, i) = 44 Or If Asc(c, i) = 46 Then
If i > 1 Then
If Asc(c, i - 1) = 44 Or If Asc(c, i - 1) = 45 Or If Asc(c, i - 1) = 46 Then
sText = Mid(c, 1, Len(c) - 1)
Else
sText = c
Endif
Else
sText = ""
Endif
Else
sText = Mid(c, 1, Len(c) - 1)
Endif
Return sText
End
Public Function ControlloValore(value As String) As String
Dim f As Float
'Print value
Try f = CFloat(Val(value))
If Error Then Return "ERRORE INATTESO"
'Print Val(value)
Return Format(Val(value), ",#.#0")
Endla nostra grande Wiki di cui spesso mi dimentico
Nel mentre avevo trovato la soluzione leggendo la nostra grande Wiki di cui spesso mi dimentico
nel capitolo Scrivere una Funzione (http://www.gambas-it.org/wiki/index.php?title=Scrivere_una_Funzione)...
Public Sub FormatVal2(sStringa As String, sFlag As String) As String[] '' Formattazione a due decimali e inserimento separatore migliaia
Dim sReturnVal As New String[]
Dim iP, iP1, iTemp, iTemp1, iCount, iPunto, iVirgola As Integer
Dim sInitStringa As String
'''' Sostituzione o aggiunta della virgola
If InStr(sStringa, ",") <> 0 Then
sStringa = Replace(sStringa, ",", ".")
Endif
If InStr(sStringa, ".") <> 0 Then
sStringa = Replace(sStringa, ".", ",")
Else
sStringa = sStringa & ",00"
Endif
''''' Controllo quante virgole o quanti punti contiene il valore da formattare
For iCount = 1 To Len(sStringa)
If InStr(".", Mid(sStringa, iCount, 1)) Then
Inc iPunto
Endif
If InStr(",", Mid(sStringa, iCount, 1)) Then
Inc iVirgola
Endif
Next
''''' Arrotondamento a due decimali
If iPunto > 1 Or iVirgola > 1 Then ' Se il valore da formattare contiene più di un punto o più di una virgola restituisce un'errore
Message.Error("<B>Uso dei decimali non corretto</B>")
sFlag = "Err"
sReturnVal.Add(sStringa)
sReturnVal.Add(sFlag)
Return sReturnVal 'stringa
Else
iP = InStr(sStringa, ",") ' Assume la posizione della virgola
iP1 = Len(sStringa) - iP ' Lunghezza della sStringa - la posizione della virgola
sInitStringa = Left(sStringa, iP - 1)
If iP = 1 Then
Message.Error("<B>Uso dei decimali non corretto</B>")
sFlag = "Err"
sReturnVal.Add(sStringa)
sReturnVal.Add(sFlag)
Return sReturnVal 'stringa
Else If iP1 = 2 Then
sStringa = sStringa
Else If iP1 <= 1 Then
sStringa = sStringa & "0"
Else If iP1 > 2 Then
iTemp = CInt(Mid(sStringa, iP + 1, 2))
iTemp1 = CInt(Mid(sStringa, iP + 1 + 2, 1))
' If iTemp1 >= 5 Then ' Se l'ultimo decimale e uguale o maggiore di 5 viene incrementato di uno
' Inc iTemp
' Endif
If iTemp = 100 Then
sStringa = CString(CInt(sInitStringa) + 1) & ",00"
Else
sStringa = sInitStringa & "," & CString(iTemp)
Endif
Endif
''''' Aggiunta puntini ogni 1000 (separatore migliaia)
If Len(sStringa) >= 7 Then
sStringa = Mid(sStringa, 1, (Len(sStringa) - 6)) & "." & Right(sStringa, 6)
Endif
If Len(sStringa) >= 11 Then
sStringa = Mid(sStringa, 1, (Len(sStringa) - 10)) & "." & Right(sStringa, 10)
Endif
If Len(sStringa) >= 15 Then
sStringa = Mid(sStringa, 1, (Len(sStringa) - 14)) & "." & Right(sStringa, 14)
Endif
If Len(sStringa) >= 19 Then
sStringa = Mid(sStringa, 1, (Len(sStringa) - 18)) & "." & Right(sStringa, 18)
Endif
sReturnVal.Add(sStringa)
sReturnVal.Add(sFlag)
Return sReturnVal 'stringa
Endif
End
Private CFormat_Valori As New CFormatValori
Private ReturnVal As String[]
Public Sub Form_Open()
Me.Center()
TextBox1.SetFocus()
End
Public Sub TextBox1_KeyPress()
TextBox1.Background = Color.Default
End
Public Sub TextBox1_Activate() ' Public Sub TextBox1_LostFocus()
Dim sFlag As String
ReturnVal = CFormat_Valori.FormatVal2(TextBox1.Text, sFlag)
If ReturnVal[1] = "" Then
TextBox1.Text = ReturnVal[0]
Else
TextBox1.Text = ReturnVal[0]
TextBox1.Background = Color.RGB(255, 255, 127)
Endif
End