Posts: 417
Threads: 75
Joined: Apr 2022
Reputation:
22
I been wanting to make this since the 1990's when I made back then in QBasic just a little chart on how to convert them in your head.
I scoured my brain the last 2 days with this and finally gave in and used Chat GPT to help me figure it out. Since it used a FUNCTION, I removed it because
I don't really know how to use FUNCTION's yet. I've used them, but don't really have the experience. I placed all the code within the program instead and fixed a
couple things. Chat GPT had wrong DIM numbers so I changed that also. Going over this in my head, line-by-line I finally figured out how it works. It's a lot easier
for me to learn by trial and error though, so I doubt I will use Chat GPT much. To me, it's kind of like copying from someone else's test at school. But at least I'm
trying to learn off of it.
What is amazing about this is that it doesn't use any LEN or RIGHT$ or LEFT$ or MID$ (which I tried over and over LOL).
Enjoy.
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
Dim values(13) As Integer
Dim symbols(13) As String
_Title "Numbers To Roman Numerals Converter"
Cls
start:
Input "Enter a number (1-3999): ", number
If number < 1 Or number > 3999 Then
Print "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
Print "Roman Numeral: "; romanNum$
End If
Print: Print: Print
GoTo start:
Posts: 3,982
Threads: 178
Joined: Apr 2022
Reputation:
220
08-12-2024, 11:23 PM
(This post was last modified: 08-12-2024, 11:26 PM by bplus.)
Nice, reminds me of the change maker I did.
Making it a function called Romanize$(number):
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
' mod b+ 2024-08-12
_Title "Numbers To Roman Numerals Converter"
For i = 1 To 3999
Print i, Romanize$(i)
If i Mod 20 = 19 Then Print "Sleeping ...zzz, press any": Sleep: Cls
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
b = b + ...
Posts: 3,982
Threads: 178
Joined: Apr 2022
Reputation:
220
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 + ...
Posts: 3,982
Threads: 178
Joined: Apr 2022
Reputation:
220
Here is an optimized version, sorry Ken I can't stop myself 
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 + ...
Posts: 417
Threads: 75
Joined: Apr 2022
Reputation:
22
LOL No problem Bplus . I've been working on my clock instead.
Posts: 3,982
Threads: 178
Joined: Apr 2022
Reputation:
220
08-13-2024, 09:24 PM
(This post was last modified: 08-13-2024, 09:28 PM by 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
b = b + ...
Posts: 417
Threads: 75
Joined: Apr 2022
Reputation:
22
Thanks! Yeah I still have everything. I would love to have my own area of this forum to post all of my best stuff, like you and Dav and others have. It's just tough when everything gets buried after time.
Posts: 89
Threads: 19
Joined: Apr 2022
Reputation:
14
(08-13-2024, 11:34 PM)SierraKen Wrote: Thanks! Yeah I still have everything. I would love to have my own area of this forum to post all of my best stuff, like you and Dav and others have. It's just tough when everything gets buried after time.
https://qb64phoenix.com/forum/forumdisplay.php?fid=62 <-- All anyone ever has to do is ask. It's not like we charge $$$ for them. (Your first payment of 9999 cent will be due at the start of next month.  )
Posts: 417
Threads: 75
Joined: Apr 2022
Reputation:
22
Thanks Admin!! I'll start adding my apps there real soon!!
Posts: 2,698
Threads: 328
Joined: Apr 2022
Reputation:
217
That dern Admin! Gosh, I was going to do it, but they beat me to it. 
|
