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