XProfan

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

proc Arab2Roem :parameters number!:declare Roem$

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

                                                                                                                else

                                                                                                                    Roem$="#:not representable!"

                                                                                                                endif

                                                                                                                return Roem$

                                                                                                            endproc

Window Title upper$("  Römische numbers in arabic Dezimalzahlen umwandeln")
Window Style 24:CLS rgb(200,200,200)
Print "\n\n\n\n"
print tab(10);" circa Römische numbers in arabic Dezimalzahlen umzuwandeln,   "
Print tab(10);" setting one first for Rome characters its numerischen "
Print tab(10);" worth: I=1 V=5 X=10 L=50 C=100 D=500 M=1000 A=5000  |b '* 100'\n"
print tab(10);" If the characters a higher worth as the previous,    "
print tab(10);" then position these combination a Subtraktion dar, z.B.:    \n"
print tab(10);" IX means X less I. there but I already add watts, must "
print tab(10);" we the value for I through take away correct and thereafter     "
print tab(10);" same nocheinmal take away, since the Voranstellung Yes a     "
print tab(10);" Subtraktion means. altogether must the worth means same    "
print tab(10);" zweimall subtrahiert go! This is for all Röm. characters! \n"
print tab(10);" ACHTUNG!   The inputted combination becomes here NOT on   "
print tab(10);" Plausibilität or on weekdays-übliche statement examined!!!    \n\n"
print tab(10);" [Button] ":waitinput :cls rgb(200,200,200):print :font 2:Declare rz$
Repeat :print " Römische number: ?  ";:Input rz$
::::if rz$="":rz$="AAAMAMMMCMDCDCCCXCLXLXXXIXVIVIII":print rz$ :endif
case left$(rz$,1)="-":break :locate %csrlin-1,35:print " =   ";int(novel2Arab(rz$))

until %key=27:END

proc novel2Arab :parameters novel$

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

whileloop Len(novel$):i&=&Loop:c$=Mid$(novel$,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