Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Numbers to Roman Numerals Converter
#3
and the other way:
Code: (Select All)
'Thanks to ChatGPT for a little help figuring this out. I fixed the DIM numbers and removed the Function and made the code simpler.
'By SierraKen on Aug. 12, 2024
'I been wanting to make this since the 1990's! LOL

' b+ mod 2 2024-08-12
$Console:Only
_Title "Numbers To Roman Numerals Converter"
B$ = String$(15, " ")
For i = 1 To 3999
    r$ = Romanize$(i)
    C$ = B$
    Mid$(C$, 1, Len(r$)) = r$
    Print i, C$, Numeralize%(r$)
Next

Function Romanize$ (number As Integer)
    Dim values(13) As Integer
    Dim symbols(13) As String

    If number < 1 Or number > 3999 Then
        Romanize$ = "Number out of range. Please enter a number between 1 and 3999."
    Else
        values(1) = 1000: symbols(1) = "M"
        values(2) = 900: symbols(2) = "CM"
        values(3) = 500: symbols(3) = "D"
        values(4) = 400: symbols(4) = "CD"
        values(5) = 100: symbols(5) = "C"
        values(6) = 90: symbols(6) = "XC"
        values(7) = 50: symbols(7) = "L"
        values(8) = 40: symbols(8) = "XL"
        values(9) = 10: symbols(9) = "X"
        values(10) = 9: symbols(10) = "IX"
        values(11) = 5: symbols(11) = "V"
        values(12) = 4: symbols(12) = "IV"
        values(13) = 1: symbols(13) = "I"
        romanNum$ = ""
        num = number
        For i = 1 To 13
            While num >= values(i)
                romanNum$ = romanNum$ + symbols(i)
                num = num - values(i)
            Wend
        Next i
        Romanize$ = romanNum$
    End If
End Function

Function Numeralize% (Roman$)
    Dim tot As Integer
    Dim copy As String
    copy = Roman$
    place = InStr(copy, "CM")
    If place Then tot = tot + 900: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "CD")
    If place Then tot = tot + 400: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "XC")
    If place Then tot = tot + 90: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "XL")
    If place Then tot = tot + 40: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "IX")
    If place Then tot = tot + 9: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "IV")
    If place Then tot = tot + 4: Mid$(copy, place, 2) = "  "
    place = InStr(copy, "M")
    While place
        tot = tot + 1000
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "M")
    Wend
    place = InStr(copy, "D")
    While place
        tot = tot + 500
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "D")
    Wend
    place = InStr(copy, "C")
    While place
        tot = tot + 100
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "C")
    Wend
    place = InStr(copy, "L")
    While place
        tot = tot + 50
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "L")
    Wend
    place = InStr(copy, "X")
    While place
        tot = tot + 10
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "X")
    Wend
    place = InStr(copy, "V")
    While place
        tot = tot + 5
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "V")
    Wend
    place = InStr(copy, "I")
    While place
        tot = tot + 1
        Mid$(copy, place, 1) = " "
        place = InStr(copy, "I")
    Wend
    Numeralize% = tot
End Function
b = b + ...
Reply


Messages In This Thread
RE: Numbers to Roman Numerals Converter - by bplus - 08-13-2024, 02:53 AM



Users browsing this thread: 1 Guest(s)