XProfan

MyOct$
by Michael Wodrich
Funktioniert "ähnlich" wie @Oct$.
Die Unterschiede:
Die Funktion arbeitet die Octalziffern mit einer Bitmaske ab und kann
so auch führende Nullen zurückgeben.
ABER: Es wird nicht geprüft, ob auch alle relevanten Stellen
abgearbeitet wurden! Gibt man also MyOct$(&1234,3) an, dann
wird nur &234 verarbeitet.
Das ist aber gewollt: es wird dann nur der untere Bereich ausgegeben
(ließe sich mit Angabe eines Startwertes noch ausbauen).
Der Programmierer sollte den Zahlenbereich also vorher abtesten.
Der 3. Parameter ist optional und kann die Ausgabe mit Leerzeichen gruppieren.

Proc MyOct$

    If %PCount > 2

        Parameters Wert&,Laenge%,Grp%

    Else

        Parameters Wert&,Laenge%
        Declare Grp%
        Grp% = 64

    EndIf

    Declare Ergebnis$,Maske&,GrpCnt%,Octa%,ShiftCnt%
    Clear Ergebnis$,ShiftCnt%
    Maske& = $7
    GrpCnt% = Grp%

    While Laenge%

        Dec Laenge%
        Dec GrpCnt%
        Octa% = If(ShiftCnt%,((Wert& & Maske&) >> (ShiftCnt% * 3)) + 48,(Wert& & Maske&) + 48)
        Ergebnis$ = Chr$(Octa%) + Ergebnis$

        If (GrpCnt% = 0) and (Laenge% > 0)

            Ergebnis$ = Chr$(32) + Ergebnis$
            GrpCnt% = Grp%

        EndIf

        Maske& = Maske& << 3
        Inc ShiftCnt%

    EndWhile

    Return Ergebnis$

EndProc

Cls
Print "1111.0000.1010.0101 - 170245:",MyOct$(%1111000010100101,2)
Print "1111.0000.1010.0101 - 170245:",MyOct$(%1111000010100101,6)
Print "1111.0000.1010.0101 - 170245:",MyOct$(%1111000010100101,8)
Print "1111.0000.1010.0101 - 170245:",MyOct$(%1111000010100101,9,3);"
"
Print "1.111.000.010.100.101 - 170245:",MyOct$(%1111000010100101,6,3);"
"
Print "&170245:",MyOct$(&170245,7)
Print "&170245:",MyOct$(&170245,7,3)
WaitKey
End