Numbers to Roman Numerals Converter

[bplus]

Ken you present some really interesting stuff. Do you remember the Lemonade Stand and your Paint program? I still have unfinished apps based on those, and your calendar ideas really improved my own!

Anyway, once again I've optimized my previous optimized code for Roman Numeral Conversions:

Code: (Select All)

_Title "Roman Numerals Converter mod 4 2024-08-13"
Dim Shared Value$, Symbol$
Value$ = "1000 900 500 400 100  90  50  40  10   9   5   4   1"
Symbol$ = " MCM DCD CXC LXL XIX VIV I"
$Console:Only
For i = 1 To 4000
    r$ = Romanize$(i): C$ = String$(15, " "): 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$ = "Out of Range": Exit Function
    num% = number
    For i% = 1 To 13
        While num% >= Val(Mid$(Value$, (i% - 1) * 4 + 1, 4))
            romanNum$ = romanNum$ + _Trim$(Mid$(Symbol$, (i% - 1) * 2 + 1, 2))
            num% = num% - Val(Mid$(Value$, (i% - 1) * 4 + 1, 4))
        Wend
    Next
    Romanize$ = romanNum$
End Function
Function Numeralize% (Roman$)
    copy$ = Roman$
    For i% = 2 To 12 Step 2
        place% = InStr(copy$, _Trim$(Mid$(Symbol$, (i% - 1) * 2 + 1, 2)))
        If place% Then tot% = tot% + Val(Mid$(Value$, (i% - 1) * 4 + 1, 4)): Mid$(copy$, place%, 2) = "  "
    Next
    For i% = 1 To 13 Step 2
        place% = InStr(copy$, _Trim$(Mid$(Symbol$, (i% - 1) * 2 + 1, 2)))
        While place%
            tot% = tot% + Val(Mid$(Value$, (i% - 1) * 4 + 1, 4))
            Mid$(copy$, place%, 1) = " "
            place% = InStr(copy$, _Trim$(Mid$(Symbol$, (i% - 1) * 2 + 1, 2)))
        Wend
    Next
    Numeralize% = tot%
End Function

Not too long I hope