EgtWPFLib/FractionStringConverter.vb

Imports System.Globalization
Imports System.Text.RegularExpressions
Imports EgtUILib
Public Module FractionStringConverter
   Public Enum FractionPattern
      None
      Feet_Inches
      Inches
   End Enum

   ' seleziona il tipo di Pattern con cui stamoare i dati
   Friend nCurrFractionPattern As FractionPattern = FractionPattern.Feet_Inches
   Public Sub SetCurrFractionPattern(nCurrFraction As FractionPattern)
      nCurrFractionPattern = nCurrFraction
   End Sub

   Friend dPrecision As Double = 64
   Public Sub SetPrecision(dVal As FractionPattern)
      dPrecision = dVal
   End Sub

   Public Function DoubleToStringFraction(dVal As Double, dBase As Double) As String
      Dim sSign As String = String.Empty
      If dVal < 0 Then
         sSign = "-"
         dVal = Math.Abs(dVal)
      End If
      Dim sFraction As String = String.Empty
      ' integer and decima part of the value
      Dim dInteger As Double = Math.Floor(dVal)
      Dim dFraction As Double = dVal - dInteger
      ' the nearest decimal numerator  
      Dim dNumeretor As Double = dFraction * dBase
      Dim dRound As Double = Math.Round(dNumeretor)
      ' estimates the irreducible fraction
      If dRound = 0 Then
         ' no decimal part
      ElseIf dRound = dBase Then
         ' no decimal part
         dInteger = dInteger + 1
      Else
         ' simplify fraction
         While dRound Mod 2 = 0
            dRound = dRound / 2
            dBase = dBase / 2
         End While
         sFraction = DoubleToString(dRound, 0) & "/" & DoubleToString(dBase, 0)
      End If
      ' sVal: dFeet'dInteger"sFraction --- dInteger sFraction
      Return WriteFraction(sSign, dInteger, sFraction)
   End Function

   ' trasforma il valore da pollici a piedi
   Private Sub ConvertInchesToFeet(ByRef dFeet As Double, ByRef dInches As Double)
      If dInches = 0 Then Return
      While dInches - 12 >= 0
         dFeet = dFeet + 1
         dInches = dInches - 12
      End While
   End Sub

   ' stampa dati in funzione del pattern dichiarato
   Private Function WriteFraction(ByVal sSign As String, ByVal dInches As Double, sFraction As String) As String
      Dim sVal As String = String.Empty
      Select Case nCurrFractionPattern
         Case FractionPattern.Feet_Inches
            Dim dFeet As Double = 0
            ConvertInchesToFeet(dFeet, dInches)
            If dFeet <> 0 Then
               sVal = String.Format("{0}'{1}""{2}", DoubleToString(dFeet, 0), DoubleToString(dInches, 0), sFraction).Trim
            Else
               If dInches <> 0 Then
                  sVal = String.Format("{0}""{1}", DoubleToString(dInches, 0), sFraction).Trim
               Else
                  sVal = String.Format("{0}", sFraction).Trim
               End If
            End If
         Case FractionPattern.Inches
            If dInches <> 0 Then
               sVal = String.Format("{0}""{1}", DoubleToString(dInches, 0), sFraction).Trim
            Else
               sVal = String.Format("{0}", sFraction).Trim
            End If
      End Select
      If Not String.IsNullOrEmpty(sVal) Then
         sVal = sSign & sVal
      End If
      Return sVal
   End Function

   ' riceve la stringa sorgente e restituisce la nuova strunga in formato decimale (senza eseguire conversioni di unità)
   Public Function OldStringFractionToStringDecimal(sVal As String, ByRef sValConverted As String) As Boolean
      Dim dVal As Double = 0
      Dim bNegativeValue As Boolean = False
      ' dato in ingresso: sVal = 2'3"23/32
      Dim sFeet As String = String.Empty
      Dim sFeetPattern As String = "(.*?)(?=')"
      Dim dFeet As Double = 0
      Dim bOkFeet As Boolean = True
      Dim bFeetExists As Boolean = False
      Dim sInch As String = String.Empty
      Dim sInchPattern As String = "(?<=')(.*?)(?="")"   ' se la stringa contiene l'apice singolo
      Dim sInchPattern1 As String = "(.*?)(?="")"        ' se la stringa NON contiene l'apice singolo
      Dim sInchPattern2 As String = "(.*?)(?=\s+)"       ' se la stringa NON contiene l'apice singolo
      Dim dInch As Double = 0
      Dim bOkInch As Boolean = True
      Dim bInchExists As Boolean = False
      Dim sFraction As String = String.Empty
      Dim sFractionPattern As String = "(?<="")(.*)"      ' se la stringa contiene l'apice doppio
      Dim sFractionPattern1 As String = "(?<=')(.*)"      ' se la stringa NON contiene l'apice doppio ma solo quello singolo
      Dim sFractionPattern2 As String = "(?<=\s+)(.*)"
      Dim dFraction As Double = 0
      Dim bOkFraction As Boolean = True
      Dim bFractionExists As Boolean = False



      ' recupero il valore di Feet (2')
      Dim sMyMatch As String = Regex.Match(sVal, sFeetPattern).Groups(1).Value
      If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
         sFeet = sMyMatch.Trim
         bOkFeet = StringToDouble(sFeet, dFeet)
         bFeetExists = True
      End If

      ' recupero il valore di Inch (3") dopo i Feet - oppure direttamente i pollici
      If bFeetExists Then
         sMyMatch = Regex.Match(sVal, sInchPattern).Groups(1).Value
      Else
         sMyMatch = Regex.Match(sVal, sInchPattern1).Groups(1).Value
      End If
      If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
         sInch = sMyMatch.Trim
         bOkInch = StringToDouble(sInch, dInch)
         bInchExists = True
      End If

      ' recupero il valore frazionario (23/32) dopo i pollici - oppure dopo i feet - oppure direttamente i valore inteso come pollici
      If bInchExists Then
         sMyMatch = Regex.Match(sVal, sFractionPattern).Groups(1).Value
      ElseIf bFeetExists And Not bInchExists Then
         sMyMatch = Regex.Match(sVal, sFractionPattern1).Groups(1).Value
      ElseIf Not bFeetExists And Not bInchExists Then
         sMyMatch = sVal
      End If
      If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
         sFraction = sMyMatch
         bOkFraction = StringToDouble(sFraction, dFraction)
      End If

      If Not bOkFeet Or Not bOkInch Or Not bOkFraction Then
         bOkFeet = True
         bOkInch = True
         bOkFraction = True

         ' separo la stringa nello spazio
         sMyMatch = Regex.Match(sVal, sInchPattern2).Groups(1).Value
         If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
            sInch = sMyMatch.Trim
            bOkInch = StringToDouble(sInch, dInch)
            bInchExists = True
         End If

         sMyMatch = Regex.Match(sVal, sFractionPattern2).Groups(1).Value
         If Not String.IsNullOrEmpty(sMyMatch) Or Not String.IsNullOrWhiteSpace(sMyMatch) Then
            sFraction = sMyMatch
            bOkFraction = StringToDouble(sFraction, dFraction)
         End If
      End If

      ' calcolo il valore decimale dell'espressione
      If bOkFeet And bOkInch And bOkFraction Then
         If dFeet < 0 OrElse dInch < 0 Or dFraction < 0 Then
            dVal = -(Math.Abs(dFeet) * 12 + Math.Abs(dInch) + Math.Abs(dFraction))
         Else
            dVal = dFeet * 12 + dInch + dFraction
         End If
         sValConverted = DoubleToString(dVal, 4)
         Return True
      Else
         Return False
      End If
   End Function

   Public Function StringFractionToStringDecimal(sVal As String, ByRef sValConverted As String) As Boolean
      sValConverted = sVal
      ' (-?) *(\d */? *\d*')? *(\d* */? *\d+-)? *(\d */? *\d* *""?)? *(\d */? *\d*)?
      Dim sPattern As String = "(-?) *(\d */? *\d*')?( *(?(?=\d+ */ *\d+)\d+ */ *\d+|\d+)""?)*"
      Dim MyMatchCollection As MatchCollection = Regex.Matches(sVal, sPattern)

      For Each MyMatch As Match In MyMatchCollection
         Dim bValueExists As Boolean = False
         Dim bNegative As Boolean = False
         Dim dFeet As Double = 0
         Dim bFeet As Boolean = True
         Dim dInch As Double = 0
         Dim bInch As Boolean = True
         Dim dFraction As Double = 0
         Dim bFraction As Boolean = True
         Dim sCurrValue As String = String.Empty
         Dim sCurrValueConverted As String = String.Empty
         Dim dCurrValueConverted As Double = 0

         For GroupIndex As Integer = 0 To MyMatch.Groups.Count - 1
            Dim MyGroup As Group = MyMatch.Groups(GroupIndex)
            Dim sGroupVal As String = MyGroup.Value
            ' verifico che il gruppo non sia vuoto
            If Not String.IsNullOrEmpty(sGroupVal) Or Not String.IsNullOrWhiteSpace(sGroupVal) Then
               Select Case GroupIndex
                  Case 0
                     ' se il valore è vuoto allora passo a prossimo Match
                     If String.IsNullOrEmpty(sGroupVal.Trim) Or String.IsNullOrWhiteSpace(sGroupVal.Trim) Then
                        Exit For
                     End If
                     ' salvo il valore del membro dell'espressione che deve essere valutato
                     sCurrValue = sGroupVal
                     bValueExists = True
                  Case 1
                     ' riconosco il segno "-" ad inizio stringa
                     bNegative = True
                  Case 2
                     ' riconosco il valore di Feet " ' "
                     sGroupVal = sGroupVal.Replace("'"c, "")
                     bFeet = StringToDouble(sGroupVal, dFeet)
                  Case 3
                     For CaptureIndex As Integer = 0 To MyGroup.Captures.Count - 1
                        Dim MyCapture As Capture = MyGroup.Captures(CaptureIndex)
                        Dim sCapture As String = MyCapture.Value
                        Select Case CaptureIndex
                           Case 0
                              ' riconosco il valore in pollici
                              sCapture = sCapture.Replace(""""c, "")
                              bInch = StringToDouble(sCapture, dInch)
                           Case 1
                              ' riconosco il valore di frazione
                              bFraction = StringToDouble(sCapture, dFraction)
                        End Select
                     Next
               End Select
            End If
         Next

         If bValueExists And bFeet And bInch And bFraction Then
            ' ricavo il valore decimale
            dCurrValueConverted = dFeet * 12 + dInch + dFraction
            If bNegative Then dCurrValueConverted = -dCurrValueConverted
            sCurrValueConverted = DoubleToString(dCurrValueConverted, 4)
            ' sostituisco il valore calcolato nell'espressione iniziale
            Dim nStartIndex As Integer = sValConverted.IndexOf(sCurrValue)
            sValConverted = sValConverted.Remove(nStartIndex, sCurrValue.Count).Insert(nStartIndex, sCurrValueConverted)
         End If
         ' passo allavalutazione del prossimo membro dell'espressione
      Next
      Dim dValueConverted As Double = 0
      If StringToDouble(sValConverted, dValueConverted) Then
         sValConverted = DoubleToString(dValueConverted, 4)
      Else
         ' Errore lettura stringa: sCurrVal non è convertibile
         Return False
      End If
      Return True
   End Function

End Module