|
|
|
| Title | Convert numbers between Roman and Arabic |
|---|
| Keywords | Roman numerals, Arabic numerals |
|---|
| Categories | Algorithms, Miscellany |
|---|
|
|
|
To convert from Roman to Arabic, convert each Roman digit into its numeric equivalent (I=1, V=5, X=10, L=50, C=100, D=500, M=1000). If this digit has value greater than the previous one, the combination represents a subtraction. For example, IX means X minus I. Because the previous digit has already been added to the result, subtract it twice and add the new digit. (For IX, the result would be 1. You would subtract 2 * I and add X giving 1 - 2 * 1 + 10 = 9.)
|
|
' Return the Arabic version of this number.
Private Function RomanToArabic(ByVal roman As String) As _
Long
Dim i As Integer
Dim ch As String
Dim result As Long
Dim new_value As Long
Dim old_value As Long
roman = UCase$(roman)
old_value = 1000
For i = 1 To Len(roman)
' See what the next character is worth.
ch = Mid$(roman, i, 1)
Select Case ch
Case "I"
new_value = 1
Case "V"
new_value = 5
Case "X"
new_value = 10
Case "L"
new_value = 50
Case "C"
new_value = 100
Case "D"
new_value = 500
Case "M"
new_value = 1000
End Select
' See if this character is bigger
' than the previous one.
If new_value > old_value Then
' The new value > the previous one.
' Add this value to the result
' and subtract the previous one twice.
result = result + new_value - 2 * old_value
Else
' The new value <= the previous one.
' Add it to the result.
result = result + new_value
End If
old_value = new_value
Next i
RomanToArabic = result
End Function
|
|
|
To convert from Arabic to Roman, examine the Arabic digits. For each digit, the program calls function AddRomanDigits to add the appropriate Roman digits to the result. That function takes as parameters the Roman digits it may need to handle the Arabic digit. For example, when handling the 10's digit in an Arabic number, the function may need the Roman digits C, L, and X to handle values such as 30 = XXX, 60 = LX, and 90 = XC.
|
|
' Return the Roman numeral version of this number.
Private Function ArabicToRoman(ByVal arabic_string As _
String) As String
Dim arabic_number As Long
Dim digit As Long
Dim result As String
If Len(arabic_string) = 0 Then Exit Function
' Pull out thousands.
arabic_number = CInt(arabic_string)
digit = arabic_number \ 1000
arabic_number = arabic_number - digit * 1000
result = result & String$(digit, "M")
' Pull out hundreds.
digit = arabic_number \ 100
arabic_number = arabic_number - digit * 100
result = AddRomanDigits(result, digit, "M", "D", "C")
' Pull out tens.
digit = arabic_number \ 10
arabic_number = arabic_number - digit * 10
result = AddRomanDigits(result, digit, "C", "L", "X")
' Pull out ones.
digit = arabic_number
result = AddRomanDigits(result, digit, "X", "V", "I")
ArabicToRoman = result
End Function
' Add appropriate Roman digits to the result.
' The ten_letter, five_letter, and one_letter
' are the digits for 10, 5, and 1 at this
' power of ten. For example, 10/5/1 = X/V/I,
' 100/50/10 = C/L/X, etc.
Private Function AddRomanDigits(ByVal result As String, _
ByVal arabic_digit As Integer, ByVal ten_letter As _
String, ByVal five_letter As String, ByVal one_letter _
As String) As String
Select Case arabic_digit
Case 1 To 3
result = result & String$(arabic_digit, _
one_letter)
Case 4
result = result & one_letter & five_letter
Case 5
result = result & five_letter
Case 6 To 8
result = result & five_letter & _
String$(arabic_digit - 5, one_letter)
Case 9
result = result & one_letter & ten_letter
End Select
AddRomanDigits = result
End Function
|
| |
|
| |
|
|
