XProfan

WindowTitle "Umwandlung Arabischer in Roemische Zahlen"
Windowstyle 24
Cls
Declare Zahl!,Roem$
print
Start:
print " Ganze positive Zahl [1..124331_dez]: ";
input Zahl!
font 2:locate %csrlin-1,48
print Arab2Roem(Zahl!):font 0
clearclip:putclip Arab2Roem(Zahl!)+"\n"
goto "Start"

proc Arab2Roem :parameters Zahl!:declare Roem$

    if (Zahl!>0) and (Zahl!<=124331)

        if Zahl!>=100000:Roem$=Roem$+"_CC|bb_":Zahl!=Zahl!-100000:endif

            if Zahl!>15000:Roem$=Roem$+"_C|b_":Zahl!=Zahl!-10000:endif

                if Zahl!>=5000:Roem$=Roem$+"A":Zahl!=Zahl!-5000:endif

                    if Zahl!>=5000:Roem$=Roem$+"A":Zahl!=Zahl!-5000:endif

                        if Zahl!>=5000:Roem$=Roem$+"A":Zahl!=Zahl!-5000:endif

                            if Zahl!>=4000:Roem$=Roem$+"MA":Zahl!=Zahl!-4000:endif

                                if Zahl!>=1000:Roem$=Roem$+"M":Zahl!=Zahl!-1000:endif

                                    if Zahl!>=1000:Roem$=Roem$+"M":Zahl!=Zahl!-1000:endif

                                        if Zahl!>=1000:Roem$=Roem$+"M":Zahl!=Zahl!-1000:endif

                                            if Zahl!>=900:Roem$=Roem$+"CM":Zahl!=Zahl!-900:endif

                                                if Zahl!>=500:Roem$=Roem$+"D":Zahl!=Zahl!-500:endif

                                                    if Zahl!>=400:Roem$=Roem$+"CD":Zahl!=Zahl!-400:endif

                                                        if Zahl!>=100:Roem$=Roem$+"C":Zahl!=Zahl!-100:endif

                                                            if Zahl!>=100:Roem$=Roem$+"C":Zahl!=Zahl!-100:endif

                                                                if Zahl!>=100:Roem$=Roem$+"C":Zahl!=Zahl!-100:endif

                                                                    if Zahl!>=90:Roem$=Roem$+"XC":Zahl!=Zahl!-90:endif

                                                                        if Zahl!>=50:Roem$=Roem$+"L":Zahl!=Zahl!-50:endif

                                                                            if Zahl!>=40:Roem$=Roem$+"XL":Zahl!=Zahl!-40:endif

                                                                                if Zahl!>=10:Roem$=Roem$+"X":Zahl!=Zahl!-10:endif

                                                                                    if Zahl!>=10:Roem$=Roem$+"X":Zahl!=Zahl!-10:endif

                                                                                        if Zahl!>=10:Roem$=Roem$+"X":Zahl!=Zahl!-10:endif

                                                                                            if Zahl!>=9:Roem$=Roem$+"IX":Zahl!=Zahl!-9:endif

                                                                                                if Zahl!>=5:Roem$=Roem$+"V":Zahl!=Zahl!-5:endif

                                                                                                    if Zahl!>=4:Roem$=Roem$+"IV":Zahl!=Zahl!-4:endif

                                                                                                        if Zahl!>=1:Roem$=Roem$+"I":Zahl!=Zahl!-1:endif

                                                                                                            if Zahl!>=1:Roem$=Roem$+"I":Zahl!=Zahl!-1:endif

                                                                                                                if Zahl!>=1:Roem$=Roem$+"I":Zahl!=Zahl!-1:endif

                                                                                                                else

                                                                                                                    Roem$="#:nicht darstellbar!"

                                                                                                                endif

                                                                                                                return Roem$

                                                                                                            endproc

WindowTitle upper$("  Römische Zahlen in Arabische Dezimalzahlen umwandeln")
WindowStyle 24:CLS rgb(200,200,200)
Print "\n\n\n\n"
print tab(10);" Um Römische Zahlen in Arabische Dezimalzahlen umzuwandeln,   "
Print tab(10);" setzt man zuerst für die Römischen Zeichen deren numerischen "
Print tab(10);" Wert: I=1 V=5 X=10 L=50 C=100 D=500 M=1000 A=5000  |b '* 100'\n"
print tab(10);" Hat das Zeichen einen höheren Wert als das vorhergehende,    "
print tab(10);" dann stellt diese Kombination eine Subtraktion dar, z.B.:    \n"
print tab(10);" IX bedeutet X minus I. Da aber I schon addiert wurde, müssen "
print tab(10);" wir den Wert für I durch Abziehen korrigieren und danach     "
print tab(10);" gleich nocheinmal abziehen, da die Voranstellung ja eine     "
print tab(10);" Subtraktion bedeutet. Insgesamt muss der Wert also gleich    "
print tab(10);" zweimall subtrahiert werden! Das gilt für alle Röm. Zeichen! \n"
print tab(10);" ACHTUNG!   Die eingegebene Kombination wird hier NICHT auf   "
print tab(10);" Plausibilität oder alltags-übliche Darstellung geprüft!!!    \n\n"
print tab(10);" [Taste] ":waitinput :cls rgb(200,200,200):print :font 2:Declare rz$
Repeat :print " Römische Zahl: ?  ";:Input rz$
::::if rz$="":rz$="AAAMAMMMCMDCDCCCXCLXLXXXIXVIVIII":print rz$ :endif
case left$(rz$,1)="-":break :locate %csrlin-1,35:print " =   ";int(Roman2Arab(rz$))

until %key=27:END

proc Roman2Arab :parameters Roman$

declare i&,c$,Arab&,new&,old& :roman$=Upper$(roman$):old&=5000

whileloop Len(Roman$):i&=&Loop:c$=Mid$(Roman$,i&,1)

    Select c$:Caseof "I":new&=1:Caseof "V":new&=5:Caseof "X":new&=10

        Caseof "L":new&=50:Caseof "C":new&=100:Caseof "D":new&=500

        Caseof "M":new&=1000:Caseof "A":new&=5000

        Caseof "|":Arab&=Arab&*100:new&=0

        otherwise :new&=0

    EndSelect

    If new&>old&: Arab&=Arab&+new&-2*old&:Else :Arab&=Arab&+new&

        EndIf :old&=new&
        endwhile :return Arab&

    EndProc