home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / zconv.bas < prev    next >
Encoding:
BASIC Source File  |  1989-10-10  |  3.8 KB  |  143 lines
  1. '* ------------------------------------------------------- *
  2. '*                        ZCONV.BAS                        *
  3. '*   Umwandlung Hex- / Oktal- / Binärzahlen <-> dezimal    *
  4. '*       (c) 1989 Florian H. Delonge  &  TOOLBOX           *
  5. '* ------------------------------------------------------- *
  6.  
  7. '* Standard für alle Variablen ist INTEGER
  8.  
  9. DEFINT A-Z
  10.  
  11. DECLARE FUNCTION HexToInt (hx$)
  12. DECLARE FUNCTION OctToInt (oc$)
  13. DECLARE FUNCTION BinToInt (bi$)
  14. DECLARE FUNCTION BIN$ (dec)
  15.  
  16. CONST CHex = "$"                 '* Kennbuchstabe für Hex-,
  17. CONST COct = "&"                 '* Oktal und
  18. CONST CBin = "%"                 '* Binärschreibweise
  19.  
  20. PRINT
  21. PRINT "Hexadezimal/Oktal/Binär <-> Integer"
  22. PRINT "  (c) 1989 F.Delonge & TOOLBOX"
  23.  
  24. DO
  25.   PRINT
  26.   PRINT "Bitte Zahl ($h, &o, %b, n) oder"
  27.   INPUT "nur <RETURN> für Ende eingeben"; x$
  28.   IF x$ = "" THEN EXIT DO
  29.  
  30.   y$ = LEFT$(x$, 1)              '* Kennbuchstaben abtrennen
  31.   z$ = "0" + UCASE$(RIGHT$(x$, LEN(x$) - 1))
  32.  
  33.                       '* Sicherheitshalber Null voranstellen
  34.                       '* falls nur Kennbuchstabe eingegeben
  35.                       '* und Umwandeln in Großbuchstaben
  36.  
  37.   SELECT CASE y$      '* Umrechnen in Dezimalzahl
  38.   CASE CHex
  39.     dec = HexToInt(z$)
  40.   CASE COct
  41.     dec = OctToInt(z$)
  42.   CASE CBin
  43.     dec = BinToInt(z$)
  44.   CASE ELSE
  45.     ldc& = VAL(x$)
  46.     IF ldc& < 32768 THEN
  47.       dec = ldc&
  48.     ELSE                       '* ggf. Komplementdarstellung
  49.       dec = ldc& - 65536
  50.     END IF
  51.   END SELECT
  52.  
  53.   PRINT                '* Ausgabe in allen Darstellungsarten
  54.   PRINT "Hexadezimal: "; HEX$(dec)
  55.   IF dec < 0 THEN                      '* Dezimalwert mit...
  56.     PRINT "Dezimal    : "; dec; " ("; dec + 65536; ")"
  57.  
  58.   ELSE                    '* oder ohne Komplementdarstellung
  59.     PRINT "Dezimal    :"; dec
  60.   END IF
  61.   PRINT "Oktal      : "; OCT$(dec)
  62.   PRINT "Binaer     : "; BIN$(dec)
  63.  
  64. LOOP                      '* ...und wieder von vorn
  65.  
  66. END
  67.  
  68. FUNCTION BIN$ (dec)   '* dezimal -> binär
  69.  
  70.   o$ = OCT$(dec)      '* Umwandeln in Oktaldarstellung
  71.   w$ = ""
  72.   FOR i = 1 TO LEN(o$)
  73.     SELECT CASE MID$(o$, i, 1)
  74.                            '* für jede Oktalziffer passende
  75.       CASE "0"             '* Bit-Dreierkombination erzeugen
  76.         w$ = w$ + "000"
  77.       CASE "1"
  78.         w$ = w$ + "001"
  79.       CASE "2"
  80.         w$ = w$ + "010"
  81.       CASE "3"
  82.         w$ = w$ + "011"
  83.       CASE "4"
  84.         w$ = w$ + "100"
  85.       CASE "5"
  86.         w$ = w$ + "101"
  87.       CASE "6"
  88.         w$ = w$ + "110"
  89.       CASE "7"
  90.         w$ = w$ + "111"
  91.     END SELECT
  92.   NEXT i
  93.   WHILE LEFT$(w$, 1) = "0" AND LEN(w$) > 1
  94.     w$ = RIGHT$(w$, LEN(w$) - 1)
  95.                         '* führende Nullen werden abgetrennt
  96.   WEND
  97.   BIN$ = w$
  98. END FUNCTION
  99.  
  100. FUNCTION BinToInt (bi$)            '* binär -> dezimal
  101.  
  102. CONST BitOn = "1"                  '* gesetztes Bit
  103. CONST BitOff = "0"                 '* nicht gesetztes Bit
  104.   dec& = 0
  105.   lng = 0
  106.   DO
  107.     IF lng = LEN(bi$) THEN EXIT DO
  108.     c$ = MID$(bi$, lng + 1, 1)
  109.     IF c$ = BitOn OR c$ = BitOff THEN
  110.       lng = lng + 1
  111.     ELSE
  112.       EXIT DO
  113.     END IF
  114.   LOOP
  115.   FOR i = 1 TO lng        '* String zeichenweise verarbeiten
  116.     c$ = MID$(bi$, i, 1)
  117.     IF c$ = BitOn AND (lng - i) < 16 THEN
  118.       msk& = 2 ^ (lng - i)    '* passende Bitmaske bestimmen
  119.       dec& = dec& OR msk&     '* und Bits in Ergebnis setzen
  120.     END IF
  121.   NEXT i
  122.   IF dec& < 32768 THEN
  123.     BinToInt = dec&
  124.   ELSE
  125.     BinToInt = dec& - 65536
  126.                     '* ggf. umwandeln in Komplentdarstellung
  127.   END IF
  128. END FUNCTION
  129.  
  130. FUNCTION HexToInt (hx$)   '* hex -> Integer
  131.  
  132.   HexToInt = VAL("&H" + hx$)
  133.  
  134. END FUNCTION
  135.  
  136. FUNCTION OctToInt (oc$)       '* oktal -> Integer
  137.  
  138.   OctToInt = VAL("&O" + oc$)
  139.  
  140. END FUNCTION
  141. '* ------------------------------------------------------- *
  142. '*                 Ende von ZCONV.BAS                      *
  143.