XProfan

Título de la ventana "Umwandlung Arabischer en Roemische Zahlen"
Windowstyle 24
Cls
Declarar Zahl!,Roem$
imprimir
Start:
imprimir " Ganze positive Zahl [1..124331_dez]: ";
input Zahl!
font 2:locate %csrlin-1,48
imprimir Arab2Roem(Zahl!):font 0
clearclip:putclip Arab2Roem(Zahl!)+"\n"
goto "Start"

proc Arab2Roem :parámetros Zahl!:declarar 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

                                                                                                                más

                                                                                                                    Roem$="#:no darstellbar!"

                                                                                                                endif

                                                                                                                volver Roem$

                                                                                                            ENDPROC

Título de la ventana upper$("  Römische Pagar en Arabische Dezimalzahlen umwandeln")
Ventana de Estilo 24:CLS rgb(200,200,200)
Imprimir "\n\n\n\n"
imprimir tab(10);" Um Römische Pagar en Arabische Dezimalzahlen umzuwandeln,   "
Imprimir tab(10);" setzt uno zuerst para el Römischen Signo deren numerischen "
Imprimir tab(10);" Valor: I=1 V=5 X=10 L=50 C=100 D=500 M=1000 A=5000  |b '* 100'\n"
imprimir tab(10);" Sombrero el Signo una höheren Valor como el vorhergehende,    "
imprimir tab(10);" entonces stellt esta Kombination una Subtraktion dar, z.B.:    \n"
imprimir tab(10);" IX bedeutet X minus I. Como aber I ya addiert wurde, necesario "
imprimir tab(10);" wir valor para I por Abziehen korrigieren y danach     "
imprimir tab(10);" igual nocheinmal abziehen, como el Voranstellung sí una     "
imprimir tab(10);" Subtraktion bedeutet. Insgesamt muss el Valor also igual    "
imprimir tab(10);" zweimall subtrahiert voluntad! Das gilt para todos Röm. Signo! \n"
imprimir tab(10);" ACHTUNG!   El eingegebene Kombination se hier NICHT en   "
imprimir tab(10);" Plausibilität oder alltags-übliche Darstellung geprüft!!!    \n\n"
imprimir tab(10);" [Taste] ":waitinput :cls rgb(200,200,200):imprimir :font 2:Declarar rz$
Repeat :imprimir " Römische Zahl: ?  ";:Entrada rz$
::::if rz$="":rz$="AAAMAMMMCMDCDCCCXCLXLXXXIXVIVIII":imprimir rz$ :endif
caso left$(rz$,1)="-":romper :locate %csrlin-1,35:imprimir " =   ";int(Roman2Arab(rz$))

until %key=27:FIN

proc Roman2Arab :parámetros Roman$

declarar 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&:Más :Arab&=Arab&+new&

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

    ENDPROC