Autore Topic: [Risolto] Intercettazione errori  (Letto 820 volte)

Offline tornu

  • Gran Maestro dei Gamberi
  • *****
  • Post: 855
    • Mostra profilo
Re:[Risolto] Intercettazione errori
« Risposta #15 il: 04 Gennaio 2018, 20:03:14 »
Giusto, questa la soluzione che ho adottato.
Una piccola premessa sulla logica se qualcuno magari vuol provare il codice:
essendo la Classe pensata per formattare i valori dei campi di un gestionale, questi vanno
digitati interi (senza separatore migliaia) separando solo i decimali con la virgola o il punto,
sarà la Classe a formattarli in modo corretto, in caso contrario sarà sollevato l'errore ed
evidenziato il campo riportando il valore errato.
Classe
Codice: [Seleziona]
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

Form
Codice: [Seleziona]
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
Saranno bene accetti suggerimenti ed eventuali migliorie.  :ciao:
Il software è come il sesso, è meglio quando è libero. (Linus Torvalds)

Offline Gianluigi

  • Moderatore globale
  • Senatore Gambero
  • *****
  • Post: 4.158
  • Tonno verde
    • Mostra profilo
Re:[Risolto] Intercettazione errori
« Risposta #16 il: 04 Gennaio 2018, 22:13:09 »
Grazie per la condivisione

 :ciao:
nuoto in attesa del bacio di una principessa che mi trasformi in un gambero azzurro