home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / zahlen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-18  |  2.9 KB  |  79 lines
  1. (*************************************************************************)
  2. (*                           ZAHLEN.PAS                                  *)
  3. (* Programm zur Umwandlung von Dezimalzahlen in Binaer-,Hexadezimal- und *)
  4. (* Oktalzahlen unter Verwendung des CASE-Tricks.                         *)
  5. (*************************************************************************)
  6.  
  7. PROGRAM zahlen_wandler;
  8.  
  9. TYPE binaer_typ = PACKED ARRAY [0..15] OF BOOLEAN;   (* Bin.-Aequivalent *)
  10.      hex_ziffer = 0..15;                             (* Hex.-Aequivalent *)
  11.      okt_ziffer = 0..7;                              (* Okt.-Aequivalent *)
  12.  
  13.      zahlen_typ = PACKED RECORD              (* um CASE-Trick anzuwenden *)
  14.                     CASE INTEGER OF
  15.                      1 : (int_zahl          : INTEGER);
  16.                      2 : (bin_zahl          : binaer_typ);
  17.                      3 : (h4,h3,h2,h1       : hex_ziffer);
  18.                      4 : (o6,o5,o4,o3,o2,o1 : okt_ziffer)
  19.                   END;
  20.  
  21.  
  22. VAR  zahl: zahlen_typ;   (* fuer Umwandlung *)
  23.      i   : INTEGER;      (* fuer INTEGER-Eingabe *)
  24.  
  25. (*************************************************************************)
  26. (* Routine zur Ausgabe von Binaerzahlen sowie der Hex.- und Okt.-Ziffern *)
  27.  
  28. PROCEDURE write_binaerzahl (b: binaer_typ);       (* Binaerzahl ausgeben *)
  29.  
  30. VAR  j: INTEGER;
  31.  
  32. BEGIN
  33.   FOR j := 15 DOWNTO 0 DO             (* mit hoechswertigem Bit anfangen *)
  34.   BEGIN
  35.     IF b[j] THEN Write('1') ELSE Write('0');
  36.     IF j = 8 THEN Write(' ')
  37.   END
  38. END;
  39.  
  40.  
  41. PROCEDURE write_hexziffer  (h: hex_ziffer);      (* Hex.-Ziffer ausgeben *)
  42.  
  43. VAR  hex_string: STRING[16];
  44.  
  45. BEGIN
  46.   hex_string := '0123456789ABCDEF'; (* alle moegl. Hex.-Ziffern geordnet *)
  47.   Write(hex_string[h+1])
  48. END;
  49.  
  50.  
  51. PROCEDURE write_oktziffer (o: okt_ziffer);       (* Okt.-Ziffer ausgeben *)
  52.  
  53. BEGIN  Write(Chr(Ord('0') + o))  END;
  54.  
  55. (*************************************************************************)
  56.  
  57. BEGIN
  58.   zahl.o6 := 0;   (* das nie mehr gebrauchte Bit 33 mit 0 initialisieren *)
  59.   REPEAT
  60.     WriteLn('( Ende durch Eingabe der INTEGER-Zahl 0 )');
  61.     WriteLn;  WriteLn;  WriteLn;
  62.     Write('INTEGER-Zahl:  ');  ReadLn(i);  WriteLn;
  63.     WITH zahl DO
  64.     BEGIN
  65.       int_zahl := i;          (* freien Verbund mit INTEGER-Zahl belegen *)
  66.       Write('binaer        :  ');         (* diese binaer interpretieren *)
  67.       write_binaerzahl(bin_zahl);
  68.       WriteLn;
  69.       Write('hexadezimal   :  ');             (* desgleichen hexadezimal *)
  70.       write_hexziffer(h4); write_hexziffer(h3);
  71.       write_hexziffer(h2); write_hexziffer(h1);
  72.       WriteLn;
  73.       Write('oktal         :  ');           (* und natuerlich auch oktal *)
  74.       write_oktziffer(o6);  write_oktziffer(o5);  write_oktziffer(o4);
  75.       write_oktziffer(o3);  write_oktziffer(o2);  write_oktziffer(o1);
  76.     END;
  77.   UNTIL i = 0
  78. END.
  79.