home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 13 / bit / bits.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-11  |  4.6 KB  |  192 lines
  1.  
  2. UNIT bits;
  3. (* ------------------------------------------------- *)
  4. (*  Diese Bibliothek stellt eine Reihe von Funk-     *)
  5. (*  tionen zur Bitmanipulation in Integer- und       *)
  6. (*  Wordvariablen zur Verfügung.                     *)
  7. (* ------------------------------------------------- *)
  8. INTERFACE
  9.  
  10. (*  Teste Bit mit Nummer BitNr.                      *)
  11. (*  True  : Bit gesetzt - False : Bit nicht gesetzt  *)
  12. FUNCTION ITstBit (Zahl: word; BitNr: INTEGER): BOOLEAN;
  13. FUNCTION BTstBit (Zahl: BYTE; BitNr: INTEGER): BOOLEAN;
  14.  
  15. (*  Setze Bit mit Nummer BitNr.                      *)
  16. FUNCTION ISetBit (Zahl: word; BitNr: INTEGER): word;
  17. FUNCTION BSetBit (Zahl: BYTE; BitNr: INTEGER): BYTE;
  18.  
  19. (*  Rotiert Zahl um Bits-Stellen nach links.         *)
  20. FUNCTION IROL (Zahl:word; Bits: INTEGER): word;
  21. FUNCTION BROL (Zahl:BYTE; Bits: INTEGER): BYTE;
  22.  
  23. (*  Rotiert Zahl um Bits-Stellen nach rechts.        *)
  24. FUNCTION IROR (Zahl: word; Bits: INTEGER): word;
  25. FUNCTION BROR (Zahl: BYTE; Bits: INTEGER): BYTE;
  26.  
  27. (*  Lösche Bit mit Nummer BitNr.                     *)
  28. FUNCTION IClrBit (Zahl: word; BitNr: INTEGER): word;
  29. FUNCTION BClrBit (Zahl: BYTE; BitNr: INTEGER): BYTE;
  30.  
  31. (*  Wandle Integer in Binaerstring um                *)
  32. FUNCTION IntStr (Zahl: word): STRING;
  33. FUNCTION BytStr (Zahl: BYTE): STRING;
  34.  
  35. (*  Wandle Binaerstring in Integer um                *)
  36. FUNCTION IntVal (Str1: STRING): word;
  37. FUNCTION BytVal (Str1: STRING): BYTE;
  38.  
  39. IMPLEMENTATION
  40.  
  41. FUNCTION ITstBit (Zahl: word; BitNr: INTEGER): BOOLEAN;
  42. BEGIN
  43.   BitNr := BitNr AND $000f;
  44.   ITstBit := ((Zahl SHR BitNr) AND 1) = 1
  45. END;
  46.  
  47. FUNCTION BTstBit (Zahl: BYTE; BitNr: INTEGER): BOOLEAN;
  48. BEGIN
  49.   BitNr := BitNr AND $0007;
  50.   BTstBit := ((Zahl SHR BitNr) AND 1) = 1
  51. END;
  52.  
  53. FUNCTION ISetBit (Zahl: word; BitNr: INTEGER): word;
  54. VAR i : word;
  55. BEGIN
  56.   BitNr := BitNr AND $000f;
  57.   i := 1;  ISetBit := Zahl OR (i SHL BitNr)
  58. END;
  59.  
  60. FUNCTION BSetBit (Zahl: BYTE; BitNr: INTEGER): BYTE;
  61. VAR i : BYTE;
  62. BEGIN
  63.   BitNr := BitNr AND $0007;
  64.   i := 1;  BSetBit := Zahl OR (i SHL BitNr)
  65. END;
  66.  
  67. FUNCTION IROL (Zahl: word; Bits: INTEGER): word;
  68. VAR   Bit15 : BOOLEAN;
  69.       x     : word;
  70.       i     : INTEGER;
  71. BEGIN
  72.   Bits := Bits AND $000f;
  73.   x := Zahl;
  74.   FOR i := 1 TO Bits DO BEGIN
  75.     Bit15 := ITstBit (x, 15);
  76.     x := x SHL 1;
  77.     IF Bit15 THEN x := ISetBit (x ,0)
  78.   END;
  79.   IROL := x
  80. END;
  81.  
  82. FUNCTION BROL (Zahl: BYTE; Bits: INTEGER): BYTE;
  83. VAR   Bit7  : BOOLEAN;
  84.       x     : BYTE;
  85.       i     : INTEGER;
  86. BEGIN
  87.   Bits := Bits AND $0007;
  88.   x := Zahl;
  89.   FOR i := 1 TO Bits DO BEGIN
  90.     Bit7 := BTstBit (x, 7);
  91.     x := x SHL 1;
  92.     IF Bit7 THEN x := BSetBit (x ,0)
  93.   END;
  94.   BROL := x
  95. END;
  96.  
  97. FUNCTION IROR (Zahl: word; Bits: INTEGER): word;
  98. VAR   Bit0 : BOOLEAN;
  99.       x    : word;
  100.       i    : INTEGER;
  101. BEGIN
  102.   Bits := Bits AND $000f;
  103.   x := Zahl;
  104.   FOR i := 1 TO Bits DO BEGIN
  105.     Bit0 := ITstBit (x, 0);
  106.     x := x SHR 1;
  107.     IF (Bit0) THEN x := ISetBit (x, 15)
  108.   END;
  109.   IROR := x
  110. END;
  111.  
  112. FUNCTION BROR (Zahl: BYTE; Bits: INTEGER): BYTE;
  113. VAR   Bit0 : BOOLEAN;
  114.       x    : BYTE;
  115.       i    : INTEGER;
  116. BEGIN
  117.   Bits := Bits AND $0007;
  118.   x := Zahl;
  119.   FOR i := 1 TO Bits DO BEGIN
  120.     Bit0 := BTstBit (x, 0);
  121.     x := x SHR 1;
  122.     IF (Bit0) THEN x := BSetBit (x, 7)
  123.   END;
  124.   BROR := x
  125. END;
  126.  
  127. FUNCTION IClrBit (Zahl: word; BitNr: INTEGER): word;
  128. VAR   x : word;
  129. BEGIN
  130.   BitNr := BitNr AND $000f;
  131.   x := $fffe;
  132.   IClrBit  := Zahl AND IROL (x, BitNr)
  133. END;
  134.  
  135. FUNCTION BClrBit (Zahl: BYTE; BitNr: INTEGER): BYTE;
  136. VAR   x : BYTE;
  137. BEGIN
  138.   BitNr := BitNr AND $0007;
  139.   x := $fe;
  140.   BClrBit  := Zahl AND BROL (x, BitNr)
  141. END;
  142.  
  143. FUNCTION IntStr (Zahl : word) : STRING;
  144. VAR i : INTEGER;
  145.     w : STRING[16];
  146. BEGIN
  147.     w := '0000000000000000';
  148.     FOR i := 15 DOWNTO 0 DO
  149.       IF ITstBit (Zahl, i) THEN
  150.         Insert ('1', w, 16 - i);
  151.     IntStr := w
  152. END;
  153.  
  154. FUNCTION BytStr (Zahl : BYTE) : STRING;
  155. VAR i : INTEGER;
  156.     w : STRING[8];
  157. BEGIN
  158.     w := '00000000';
  159.     FOR i := 7 DOWNTO 0 DO
  160.       IF BTstBit (Zahl, i) THEN
  161.         Insert ('1', w, 8 - i);
  162.     BytStr := w
  163. END;
  164.  
  165. FUNCTION IntVal (Str1 : STRING) : word;
  166. VAR i, j : INTEGER;
  167.     k    : word;
  168. BEGIN
  169.     k := 0;
  170.     j := Length (Str1);
  171.     IF (j > 16) THEN j := 16;
  172.     FOR i := j DOWNTO 1 DO
  173.       IF (Str1[i] = '1') THEN
  174.         k := ISetBit (k, j - i);
  175.     IntVal := k
  176. END;
  177.  
  178. FUNCTION BytVal (Str1 : STRING) : BYTE;
  179. VAR i, j : INTEGER;
  180.     k    : BYTE;
  181. BEGIN
  182.     k := 0;
  183.     j := Length (Str1);
  184.     IF (j > 8) THEN j := 8;
  185.     FOR i := j DOWNTO 1 DO
  186.       IF (Str1[i] = '1') THEN
  187.         k := BSetBit (k, j - i);
  188.     BytVal := k
  189. END;
  190.  
  191. END.
  192.