63 lines
1.6 KiB
Plaintext
63 lines
1.6 KiB
Plaintext
' FB 1.05.0 Win64
|
|
|
|
Function romanDecode(roman As Const String) As Integer
|
|
If roman = "" Then Return 0 '' zero denotes invalid roman number
|
|
Dim roman1(0 To 2) As String = {"MMM", "MM", "M"}
|
|
Dim roman2(0 To 8) As String = {"CM", "DCCC", "DCC", "DC", "D", "CD", "CCC", "CC", "C"}
|
|
Dim roman3(0 To 8) As String = {"XC", "LXXX", "LXX", "LX", "L", "XL", "XXX", "XX", "X"}
|
|
Dim roman4(0 To 8) As String = {"IX", "VIII", "VII", "VI", "V", "IV", "III", "II", "I"}
|
|
Dim As Integer i, value = 0, length = 0
|
|
Dim r As String = UCase(roman)
|
|
|
|
For i = 0 To 2
|
|
If Left(r, Len(roman1(i))) = roman1(i) Then
|
|
value += 1000 * (3 - i)
|
|
length = Len(roman1(i))
|
|
r = Mid(r, length + 1)
|
|
length = 0
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
For i = 0 To 8
|
|
If Left(r, Len(roman2(i))) = roman2(i) Then
|
|
value += 100 * (9 - i)
|
|
length = Len(roman2(i))
|
|
r = Mid(r, length + 1)
|
|
length = 0
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
For i = 0 To 8
|
|
If Left(r, Len(roman3(i))) = roman3(i) Then
|
|
value += 10 * (9 - i)
|
|
length = Len(roman3(i))
|
|
r = Mid(r, length + 1)
|
|
length = 0
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
For i = 0 To 8
|
|
If Left(r, Len(roman4(i))) = roman4(i) Then
|
|
value += 9 - i
|
|
length = Len(roman4(i))
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
' Can't be a valid roman number if there are any characters left
|
|
If Len(r) > length Then Return 0
|
|
Return value
|
|
End Function
|
|
|
|
Dim a(2) As String = {"MCMXC", "MMVIII" , "MDCLXVI"}
|
|
For i As Integer = 0 To 2
|
|
Print a(i); Tab(8); " =>"; romanDecode(a(i))
|
|
Next
|
|
|
|
Print
|
|
Print "Press any key to quit"
|
|
Sleep
|