XProfan

Titre de la fenêtre "Umwandlung Arabischer dans Roemische Zahlen"
Windowstyle 24
Cls
Déclarer numéro!,Roem$
imprimer
Start:
imprimer " Ganze positive numéro [1..124331_dez]: ";
input numéro!
font 2:locate %csrlin-1,48
imprimer Arab2Roem(numéro!):font 0
clearclip:putclip Arab2Roem(numéro!)+"\n"
goto "Start"

proc Arab2Roem :parameters numéro!:declare Roem$

    si (numéro!>0) and (numéro!<=124331)

        si numéro!>=100000:Roem$=Roem$+"_CC|bb_":numéro!=numéro!-100000:endif

            si numéro!>15000:Roem$=Roem$+"_C|b_":numéro!=numéro!-10000:endif

                si numéro!>=5000:Roem$=Roem$+"A":numéro!=numéro!-5000:endif

                    si numéro!>=5000:Roem$=Roem$+"A":numéro!=numéro!-5000:endif

                        si numéro!>=5000:Roem$=Roem$+"A":numéro!=numéro!-5000:endif

                            si numéro!>=4000:Roem$=Roem$+"MA":numéro!=numéro!-4000:endif

                                si numéro!>=1000:Roem$=Roem$+"M":numéro!=numéro!-1000:endif

                                    si numéro!>=1000:Roem$=Roem$+"M":numéro!=numéro!-1000:endif

                                        si numéro!>=1000:Roem$=Roem$+"M":numéro!=numéro!-1000:endif

                                            si numéro!>=900:Roem$=Roem$+"CM":numéro!=numéro!-900:endif

                                                si numéro!>=500:Roem$=Roem$+"D":numéro!=numéro!-500:endif

                                                    si numéro!>=400:Roem$=Roem$+"CD":numéro!=numéro!-400:endif

                                                        si numéro!>=100:Roem$=Roem$+"C":numéro!=numéro!-100:endif

                                                            si numéro!>=100:Roem$=Roem$+"C":numéro!=numéro!-100:endif

                                                                si numéro!>=100:Roem$=Roem$+"C":numéro!=numéro!-100:endif

                                                                    si numéro!>=90:Roem$=Roem$+"XC":numéro!=numéro!-90:endif

                                                                        si numéro!>=50:Roem$=Roem$+"L":numéro!=numéro!-50:endif

                                                                            si numéro!>=40:Roem$=Roem$+"XL":numéro!=numéro!-40:endif

                                                                                si numéro!>=10:Roem$=Roem$+"X":numéro!=numéro!-10:endif

                                                                                    si numéro!>=10:Roem$=Roem$+"X":numéro!=numéro!-10:endif

                                                                                        si numéro!>=10:Roem$=Roem$+"X":numéro!=numéro!-10:endif

                                                                                            si numéro!>=9:Roem$=Roem$+"IX":numéro!=numéro!-9:endif

                                                                                                si numéro!>=5:Roem$=Roem$+"V":numéro!=numéro!-5:endif

                                                                                                    si numéro!>=4:Roem$=Roem$+"IV":numéro!=numéro!-4:endif

                                                                                                        si numéro!>=1:Roem$=Roem$+"I":numéro!=numéro!-1:endif

                                                                                                            si numéro!>=1:Roem$=Roem$+"I":numéro!=numéro!-1:endif

                                                                                                                si numéro!>=1:Roem$=Roem$+"I":numéro!=numéro!-1:endif

                                                                                                                d'autre

                                                                                                                    Roem$="#:pas darstellbar!"

                                                                                                                endif

                                                                                                                return Roem$

                                                                                                            endproc

Titre de la fenêtre upper$("  Römische payons dans Arabische Dezimalzahlen umwandeln")
Fenêtre Style 24:CLS rgb(200,200,200)
Imprimer "\n\n\n\n"
imprimer tab(10);" Um Römische payons dans Arabische Dezimalzahlen umzuwandeln,   "
Imprimer tab(10);" mets on d'abord pour qui Römischen marque en numerischen "
Imprimer tab(10);" Wert: I=1 V=5 X=10 L=50 C=100 D=500 M=1000 A=5000  |b '* 100'\n"
imprimer tab(10);" Hat cela marque une höheren Wert comme cela vorhergehende,    "
imprimer tab(10);" ensuite stellt cet Kombination une Subtraktion dar, z.B.:    \n"
imprimer tab(10);" IX bedeutet X minus I. là mais I déjà addiert wurde, doit "
imprimer tab(10);" wir la valeur pour I par Abziehen korrigieren et après     "
imprimer tab(10);" juste nocheinmal abziehen, là qui Voranstellung oui une     "
imprimer tab(10);" Subtraktion bedeutet. en tout muss qui Wert alors juste    "
imprimer tab(10);" zweimall subtrahiert volonté! cela gilt pour alle Röm. marque! \n"
imprimer tab(10);" ACHTUNG!   qui eingegebene Kombination wird ici NICHT sur   "
imprimer tab(10);" Plausibilität ou bien alltags-übliche représentation geprüft!!!    \n\n"
imprimer tab(10);" [bouton] ":waitinput :cls rgb(200,200,200):imprimer :font 2:Déclarer rz$
Repeat :imprimer " Römische numéro: ?  ";:Contribution rz$
::::si rz$=»:rz$="AAAMAMMMCMDCDCCCXCLXLXXXIXVIVIII":imprimer rz$ :endif
cas left$(rz$,1)="-":pause :locate %csrlin-1,35:imprimer " =   ";int(Roman2Arab(rz$))

until %clé=27:FIN

proc Roman2Arab :parameters Roman$

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

whileloop Len(Roman$):i&=&Boucle: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

    Si new&>old&: Arab&=Arab&+new&-2*old&:D'autre :Arab&=Arab&+new&

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

    ENDPROC