Code-Beispiel

Zahlsystem-Umrechner

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	ytwinky	13.01.2011

Es kann nicht angehen, daß es im FreeBASIC-Portal keinen Zahlsystem-Umrechner gibt..
Diese Aufgabe fällt häufig auf der Befehlszeile an, also ist es ein Konsolen-Programm!
(funktioniert auch auf der Befehlszeile..)
Ab v2.0 wird auch InputLn() zur sichereren Eingabe eingebaut sein ;-))

#include "crt.bi"

#include "vbcompat.bi"

#define ArgC ((*__p___argc())-1)

#ifndef False

    Const False=0, True=Not False

#endif

#Undef GoTo 'Jojo hat Recht, danke ;-))

'+-----------------------------------------------------------------------------------+

'|    Header: Bestimmen der Übergabeparameter                                        |

'|    AnzeigeCheck:|Il1 sind:Alt-0124, Großes i, kleines L, Eins „ä”öüáßŽÄ™ÖšÜñ±ø°¸©|

Const Autor="UmRechner.Bas v1.0  ¸2011 by ytwinky, MD"'                              |

'|           (Tastenkombination: keine)                                              |

Const FBVer="Getestet mit FB 0.21.1 und dem aktuellen FBEdit"'|                      |

'|    Zweck : Umrechner für die verschiedenen Zahlensystem die FreeBASIC beherrscht  |

'+-----------------------------------------------------------------------------------+

'(Anmerkung zu den Sonderzeichen: zuerst steht das DOS-Zeichen, danach das Windowszeichen)

'ein Fall für InputLn

Type yInteger As LongInt

Const Esc=!"\27", rot=4, hell=8

Declare Function Align(What As String, How As String="Right", FieldWidth As Integer=10) As String

Declare Function GetChr(s As String, lowcase As Integer=1=0) As String 'returns a single char

Declare Function MenuChar(s As String, First As Integer=1, nVG As Integer=hell+rot)As String

Declare Function mkuint(i As yInteger, wb As Integer) As String

Declare Function PrintIt(Wert As String, Titel As String, wb As Integer) As String

Declare Sub Ausgabe(i As yInteger, wb As Integer, ob As Integer=11)

Declare Sub Hilfe(ClearScreen As Integer=True)

Declare Function myOct(What As Integer, wb As Integer, ob As Integer) As String



Var s=Autor &!"\nEin Konsolen-Programm zum Umrechnen zwischen den Zahlensystemen\n", w="w", c=w, fmt=""

Dim As Integer b(1 To 3)={8, 16, 32}, o(1 To 3)={3, 6, 11}, wb=0, mp=0, dnr=0

Dim i As yInteger=0

Dim Shared As Integer FirstRun=True, ScrWidth

ScrWidth=LoWord(Width)

If ArgC Then 'Parameter übergeben?

  Select Case LCase(Command(1))

    Case "/?", "-?", "/h", "-h", "/hilfe", "--help", "--hilfe"

        Hilfe(1=0)

    Case Else

        'DateiName ermitteln

        'Datei öffnen

        'Wenn vorhanden:Zeile einlesen und aufteilen in Zahl und Breite, in Liste speichern

        '               Datei schließen..

        'Wenn nicht vorhanden: Fehlermeldung und Ende

        If Instr(Command(1), "@") Then

            dnr=FreeFile

        If Open(Mid(Command(1), 2) For Input As #DNr) Then

            Print "Datei " & Mid(Command(1), 2) &!" l„át sich nicht ”ffnen!\n**U**"

            'Im Programm bleiben, damit der Benutzer die Hilfe aufrufen kann, ansonsten: End Asc(Esc)

        Else

            Print "Auswertung von Datei " & Mid(Command(1), 2) &!"\n" &String(29, 32) &"Bin " &_

                  "     Hex         Int       uInt " & String(6, 32) &"myOct"

            While Not Eof(DNr)

                Line Input #DNr, c

                i=Val(c)

                mp=InStr(c, " ")

                If mp<>0 Then c=lcase(Mid(c, mp+1, 1))

                If InStr("bwd", c) Then w=c

                wb=InStr("bwd", w)

                If i<2^32 And i>=(-2^31) Then

                    fmt=String(32-b(wb), 32) & Bin(i, b(wb)) & String(9-b(wb)\4, 32) & Hex(i, b(wb)\4)

                    fmt &= Right(String(12, 32) &Str(i), 12) & Right(String(11, 32) &mkuint(i, b(wb)), 11)

                    Print fmt & String(12-o(wb), 32) & myOct(i, b(wb), o(wb))

                Else

                    Print i &" ist KEIN 32Bit-Integer.."

                End If

            Wend

            Close(DNr)

            End

        EndIf

        Else

        i=Val(Command(1))

        If Command(2)<>"" Then w=lcase(Command(2))

        wb=InStr("bwd", w)

        If wb=0 Then wb=2

        FirstRun=False

        Ausgabe(i, b(wb), o(wb))

      End If

  End Select

Else

    Cls

    Print Autor

    Do

        wb=InStr("bwd", w)

        Locate 1, 1

        Print Autor &!"\n"; MenuChar("Eingabe, "); MenuChar("Wortbreite[aktuell " & b(wb) &" Bit] ");

        Print MenuChar("Hilfe "); MenuChar("Quit(auch ESC)->Programmende") &" "

        Ausgabe(i, b(wb), o(wb))

        mp=CsrLin

        Locate mp, 1

        Print "Was darf's denn sein?";

        Do

            c=GetChr("", True)

        Loop Until InStr(!"ehwqx" &Esc, c)

        Select Case c

            Case "h"

                Hilfe()

            Case "e"

                Locate mp, 1

                Input "neue (Integer-)Zahl eingeben:", i

                Locate mp, 1

                Print String(ScrWidth, 32) &!"\n" &String(ScrWidth, 32);

                FirstRun=False

            Case "w"

                Locate mp, 1

                Print "Neue Breite "; MenuChar("Byte(8), "); MenuChar("Wort(16), "); MenuChar("DoppelWort(32):");

                Do

                    c=GetChr("", True)

                Loop Until InStr("bwd" &Esc, w)

                w=*IIf(c<>Esc, @c, @w)

                Locate mp, 1

                Print String(ScrWidth, 32);

                Locate 3, 1

                Ausgabe(i, b(wb), o(wb))

        End Select

    Loop Until InStr("qx" &Esc, c)

EndIf

End



Function Align(What As String, How As String="Right", FieldWidth As Integer=11) As String

    '©2008 by ytwinky, MD

    Var Aligned=Space(FieldWidth), le=Len(What)

    Select Case How[0]

        Case 114, 82 '=r it is ok to submit 'r' for 'Right', which is the default

            RSet Aligned, What

        Case 108, 76 'same with 'l' which aligns to the 'Left'

            LSet Aligned, What

        Case Else 'now there's only 'c' left

            LSet Aligned, What

            If le<FieldWidth Then

                Aligned=Left(Space((FieldWidth-le)\2) &Aligned, FieldWidth)

            End If

    End Select

    Return Aligned

End Function



Function GetChr(s As String, lowcase As Integer=1=0) As String 'returns a single char

  '¸©2008 by ytwinky, MD

    Var m="" 'it is always a good habit to declare variables, we are going to use..

    If s<>"" Then Print s; 'show inputprompt, if any..

  Do

    Do

      m=InKey

      Sleep 1

    Loop Until m<>"" And Len(m)=1 'ignore FunKeys and NoKeys

  Loop Until m[0]>31 And m[0]<256 Or Instr(Chr(13, 27), m) 'm is printable or cr or esc

    If lowcase Then Return lcase(m) 'convert if desired

  Return m ' just m only

End Function ' done..



Function MenuChar(s As String, First As Integer=1, nVG As Integer=hell+rot)As String

  Var cVG=LoWord(Color), cHG=HiWord(Color)

  If First<>1 Then Print Left(s, First-1);

  Color nVG

  Print Chr(s[First-1]);

  Color cVG

  Return Mid(s, First+1)

End Function



Function mkuint(i As yInteger, wb As Integer) As String

    Dim As uLongInt uInt

    If i>=0 Then Return Str(i)

    uInt=2^wb+i

    Return Str(uInt)

End Function



Function PrintIt(Wert As String, Titel As String, wb As Integer) As String

    If FirstRun Then Return Titel

    Print Align(Wert, "r", wb);

  Return Titel &String(ScrWidth-wb-Len(Titel)-1,32)

End Function



Sub Ausgabe(i As yInteger, wb As Integer, ob As Integer)

    Print Right("FEDCBA9876543210FEDCBA9876543210", wb) &" Bit-Nr.(nur Orientierungshilfe)";String(ScrWidth-Pos(), 32)

    Print PrintIt(Bin(i, wb), " Bin„r", wb)

    Print PrintIt(Hex(i, wb\4), " Hexadezimal", wb)

    Print PrintIt(Str(i), " Integer", wb)

    Print PrintIt(mkuint(i, wb), " uInteger", wb)

    Print PrintIt(myOct(i, wb, ob), " Oktal", wb)

End Sub



Sub Hilfe(ClearScreen As Integer=True)

    Var s=Autor &!"\nEin Konsolen-Programm zum Umrechnen von 32Bit-Integers zwischen den Zahlensystemen\n"

    Cls

    s &= !"Benutzt wird die FreeBASIC-Zahlenschreibweise mit:\n  &b01010101 fr Bin„r-Zahlen\n"

    s &= !"  &h0123456789ABCDEF fr Hexadezimal-Zahlen\n  &o01234567 fr Oktal-Zahlen\n"

    s &= !"  -0123456789 fr Integer-Zahlen\nDie angegebenen Ziffern sind gleichzeitig auch der Wertebereich.\n"

    s &= "Bearbeitet werden Zahlen von -" &(2^31) &".." &(2^32) &!"!\n(Nein, eine 64Bit-Version ist nicht geplant^^)\n"

    s &= !"Aufruf: Umrechner [[-h]|[@DateiName]|[[prefix]Zahl] [Wortbreite]]]\nWobei\n  -h\t\tEINE M”glichkeit ist, diese Seite aufzurufen\n"

    s &= !"  @DateiName\teine formatierte Datei ist\n"

    s &= !"  prefix\t&h, &b oder &o sein kann\n  Zahl\t\tInteger mit Ziffern aus dem jeweiligen Wertebereich ist\n"

    s &= !"  Wortbreite\tByte(8Bit)=B, Wort(16Bit)=W, DoppelWort(32Bit)=D)\n"

    s &= !"WICHTIG: bei negativen Integers wird uInteger aus der Wortbreite ermittelt!\n"

    s &= !"         In der Befehlszeile mssen Zahlen mit prefix von """" umgeben sein, sonst ist es ein Befehl\n"

    s &= !"         Berechnung von Oktal-Zahlen erfolgt mit myOct() und NICHT mit Oct() wg. Darstellung..\n"

    s &= !"Dateiformat(jeweils zeilenweise) in einer Ascii-Datei:\n[prefix]Zahl [Wortbreite]\n[prefix]Zahl [Wortbreite]\n..\n"

    s &= !"Wortbreite gilt bis eine neue gesetzt wird(so sind pro Datei mehrere m”glich)!\n"

    s &= !"Ein Aufruf ohne Parameter startet das Men"

    Print s;

    If ClearScreen Then

        GetKey 'GetKey ist doch besser als Sleep, wer will kann ja mal Sleep probieren^^..

        Cls

    EndIf

End Sub



Function myOct(What As Integer, wb As Integer, ob As Integer=11) As String

  Dim As LongInt l=IIf(What<0, Cast(LongInt, What+2^wb), Cast(LongInt, What))

  Return Oct(l, ob)

End Function

Wer mag, kann ja diese Text-Datei mal umrechnen lassen:

0 b

0 w

0 d

255 b

256 w

32767

32768

32769

32767 d

32768

32769

65535 w

65536 d

&H7FFFFFFF

&H80000000

&h80000001

&hFFFFFFFF

&h100000000

-1 b

-1 w

-1 d

-2147483647

2147483647

-2147483647

-2147483648

-2147483649

Als Daten.Txt im selben Verzeichnis wie Umrechner.Exe speichern und dann aufrufen mit:

Umrechner @Daten.Txt

Viel Spaß damit
Gruß
ytwinky

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 10.01.2011 von ytwinky angelegt.
Die aktuellste Version wurde am 13.01.2011 von ytwinky gespeichert.

Bearbeiten

Versionen