Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Numbers to Roman Numerals Converter
#4
Here is an optimized version, sorry Ken I can't stop myself Smile
Code: (Select All)
_Title "Roman Numerals Converter mod 3 2024-08-13"
' third mod to SierraKen's great start:
' "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"

Dim Shared Values(1 To 13) As Integer, Symbols(1 To 13) As String
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"

$Console:Only

B$ = String$(15, " ")
For i = 1 To 3999
    r$ = Romanize$(i): C$ = B$: n% = Numeralize%(r$)
    Mid$(C$, 1, Len(r$)) = r$
    Print i, C$; n%
    If i <> n% Then Beep: Sleep ' keep us honest :)
Next

Function Romanize$ (number As Integer)
    If number < 1 Or number > 3999 Then
        Romanize$ = "Number out of range. Please enter a number between 1 and 3999."
    Else
        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 As Integer tot, i
    Dim copy As String
    copy = Roman$
    For i = 2 To 12 Step 2
        place = InStr(copy, Symbols(i))
        If place Then tot = tot + Values(i): Mid$(copy, place, 2) = "  "
    Next
    For i = 1 To 13 Step 2
        place = InStr(copy, Symbols(i))
        While place
            tot = tot + Values(i)
            Mid$(copy, place, 1) = " "
            place = InStr(copy, Symbols(i))
        Wend
    Next
    Numeralize% = tot
End Function
b = b + ...
Reply


Messages In This Thread
RE: Numbers to Roman Numerals Converter - by bplus - 08-13-2024, 07:11 PM



Users browsing this thread: 4 Guest(s)