Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Zahlsystem-Umrechner

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Redakteurytwinky 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 fr Bin„r-Zahlen\n"
    s &= !"  &h0123456789ABCDEF fr Hexadezimal-Zahlen\n  &o01234567 fr Oktal-Zahlen\n"
    s &= !"  -0123456789 fr 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 mssen 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 Redakteurytwinky angelegt.
  • Die aktuellste Version wurde am 13.01.2011 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen