DataMystic

Code: Select all

Function Roman2Decimal( ByVal strRoman )
' This Function converts strRoman to its decimal numerical value.
' Written by: Rob van der Woude, http://www.robvanderwoude.com
'
' Roman numerals "old style" will still be converted correctly
' into decimal numbers. However, numerals like "MIIIM" for 1997
' would be invalid in any notation, and consequently will
' return invalid results.
'
' More information on Roman numerals can be found on WikiPedia:
' http://en.wikipedia.org/wiki/Roman_numerals

    ' Some housekeeping
    Dim arrRoman( ), intRoman
    ReDim arrRoman( Len( strRoman ) -1 )
    intRoman = 0

    ' Store each "digit" of the Roman numeral in an array
    For i = 0 To UBound( arrRoman )
        arrRoman( i ) = Mid( strRoman, i + 1, 1 )
    Next

    ' Then convert each "digit" to its numeric value
    For i = 0 To UBound( arrRoman )
        Select Case arrRoman( i )
            Case "M"
                arrRoman( i ) = 1000
            Case "D"
                arrRoman( i ) = 500
            Case "C"
                arrRoman( i ) = 100
            Case "L"
                arrRoman( i ) = 50
            Case "X"
                arrRoman( i ) = 10
            Case "V"
                arrRoman( i ) = 5
            Case "I"
                arrRoman( i ) = 1
        End Select
    Next

    ' Now comes the hard part: for each "digit" decide if it will be
    ' added or subtracted, based on the value of the following "digit"
    For i = 0 To UBound( arrRoman ) - 1
        If     arrRoman( i ) < arrRoman( i + 1 ) Then
            ' E.g. "I" in "IX" (9): subtract 1
            intRoman = intRoman - arrRoman( i )
        ElseIf arrRoman( i ) = arrRoman( i + 1 ) Then
            ' E.g. "I" in "XII" (12), "III" (3) or in "IIX" (ancient notation for 8).
            ' The latter should actually be "VIII" in "modern" roman numerals, but
            ' "IIX" was used in ancient times, so let's just be prepared.
            ' We'll add the value to the next position in the array, so it will be
            ' reevaluated in the next iteration of the loop.
            ' Note: this trick will definitely fail on invalid notations like "IIIX".
            arrRoman( i + 1 ) = arrRoman( i ) + arrRoman( i + 1 )
            arrRoman( i )     = 0
        Else ' arrRoman( i ) > arrRoman( i + 1 )
            ' E.g. "V" in "XV" (15): add 5
            intRoman = intRoman + arrRoman( i )
        End If
    Next

    ' The last "digit" doesn't have a following "digit" so it
    ' can, be added without having to test a following "digit"
    intRoman= intRoman + arrRoman( UBound( arrRoman ) )
    
    ' Return the calculated value
    Roman2Decimal = intRoman
End Function


Sub Syntax( ByVal strErr )
    If strErr <> "" Then
        strMsg = vbCrLf & strErr & vbCrLf & vbCrLf
    Else
        strMsg = vbCrLf
    End If
    strMsg = strMsg _
           & "Romans.vbs,  Version 1.01" & vbCrLf _
           & "Convert between Roman and decimal numerals." & vbCrLf & vbCrLf _
           & "Usage:  ROMANS.VBS  numeral" & vbCrLf & vbCrLf _
           & "Where:             ""numeral""  is either a (decimal) integer in the" & vbCrLf _
           & "                              range of 1..4999, or a Roman numeral." & vbCrLf & vbCrLf _
           & "Notes:  [1] Returned Roman numerals follow ""modern"" conventions," & vbCrLf _
           & "            i.e. 1999 will be written as ""MCMXCIX"" instead of ""MIM""." & vbCrLf _
           & "            However, these Roman numerals ""old style"" will still be" & vbCrLf _
           & "            converted correctly into decimal numbers." & vbCrLf _
           & "            Numerals like ""MIIIM"" for 1997 would be invalid in any" & vbCrLf _
           & "            notation, and consequently will return invalid results." & vbCrLf _
           & "        [2] More information on Roman numerals can be found on WikiPedia:" & vbCrLf _
           & "            http://en.wikipedia.org/wiki/Roman_numerals" & vbCrLf & vbCrLf _
           & "Written by Rob van der Woude" & vbCrLf _
           & "http://www.robvanderwoude.com"
    WScript.Echo strMsg
    WScript.Quit( 1 )
End Sub