XProfan

Arab2Roem$ - Wandelt eine Zahl in römische Zahlzeichen um
siehe auch: Roem2Arab$()
Additionszahlensystem - römische Zahlen
1. Jedes der Zeichen I (1), X (10), C (100) darf höchstens 3mal
in einer Zahl nebeneinander vorkommen.
2. Jedes der Zeichen V (5), L (50) und D (500) darf
in einer Zahl nur einmal vorkommen.
3. Steht eines der Grundzeichen I (1), X (10), oder C (100) vor einem der
Zeichen V (5), X (10), L (50), C (100), D (500) oder M (1000) mit größerem
Wert, so wird der Wert des kleineren von dem mit dem größeren Wert abgezogen.
4. Es darf in jeder Zahlendarstellung immer nur ein Grundzeichen vorangestellt werden:
1098 = MXCVIII  aber nicht  IMIC
5. Für eine Zahl sollen immer möglichst wenige Ziffern verwendet werden.
-------------------------------------------------------

Proc Arab2Roem$

    Parameters zahl&
    Declare erg$

    While Zahl& >= 1000 : erg$ = erg$ + M  : Sub zahl&,1000 : EndWhile

        If    Zahl& >=  900 : erg$ = erg$ + CM : Sub zahl&, 900 : EndIf

            If    Zahl& >=  500 : erg$ = erg$ + D  : Sub zahl&, 500 : EndIf

                If    Zahl& >=  400 : erg$ = erg$ + CD : Sub zahl&, 400 : EndIf

                    While Zahl& >=  100 : erg$ = erg$ + C  : Sub zahl&, 100 : EndWhile

                        If    Zahl& >=   90 : erg$ = erg$ + XC : Sub zahl&,  90 : EndIf

                            If    Zahl& >=   50 : erg$ = erg$ + L  : Sub zahl&,  50 : EndIf

                                If    Zahl& >=   40 : erg$ = erg$ + XL : Sub zahl&,  40 : EndIf

                                    While Zahl& >=   10 : erg$ = erg$ + X  : Sub zahl&,  10 : EndWhile

                                        If    Zahl& >=    9 : erg$ = erg$ + IX : Sub zahl&,   9 : EndIf

                                            If    Zahl& >=    5 : erg$ = erg$ + V  : Sub zahl&,   5 : EndIf

                                                If    Zahl& >=    4 : erg$ = erg$ + IV : Sub zahl&,   4 : EndIf

                                                    While Zahl& >=    1 : erg$ = erg$ + I  : Sub zahl&,   1 : EndWhile

                                                        Return erg$

                                                    EndProc

                                                    Cls
                                                    print römische Zahlzeichen:
                                                    print    7 =,Arab2Roem$(7)
                                                    print   84 =,Arab2Roem$(84)
                                                    print 1932 =,Arab2Roem$(1932)
                                                    print 2006 =,Arab2Roem$(2006)
                                                    WaitKey
                                                    ='./../../function-references/XProfan/end/'>End