home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 13 / bit / bit.pas next >
Encoding:
Pascal/Delphi Source File  |  1988-09-26  |  5.8 KB  |  186 lines

  1. (* ------------------------------------------------------ *)
  2. (*                     BIT.PAS                            *)
  3. (*   Funktionen zur Bitmanipulation in Turbo Pascal 4.0   *)
  4. (*        Verbesserung der Unit aus PASCAL 8/9'88         *)
  5. (*                                                        *)
  6. (*        (c) 1988 by Ralf Randermann & TOOLBOX           *)
  7. (* ------------------------------------------------------ *)
  8.  
  9. UNIT Bit;
  10.  
  11. INTERFACE
  12.  
  13. (* ------------------------------------------------------ *)
  14. (* Die Bits einer Integerzahl werden entsprechend ihrer   *)
  15. (* Wertigkeit durchnumeriert, d.h. Bit 0 entspricht der   *)
  16. (* ersten Stelle vor dem Komma (Wertigkeit 2 hoch 0) usw. *)
  17. (* Bits, deren Wertigkeit außerhalb des Geltungsbereichs  *)
  18. (* des entsprechenden Typs liegen, z.B. Bit 128, sind     *)
  19. (* immer Null. Achtung: bei shortint ist Bit 7 und bei    *)
  20. (* integer Bit 15 das Vorzeichenbit!                      *)
  21. (* ------------------------------------------------------ *)
  22.  
  23. FUNCTION TestBit(Zahl: WORD; BitNr: BYTE): BOOLEAN;
  24. (* true, wenn das Bit <BitNr> in Zahl gesetzt ist         *)
  25.  
  26. FUNCTION SetBit(Zahl: WORD; BitNr: BYTE): WORD;
  27. (* liefert als Ergebnis den Wert von <Zahl> mit gesetztem *)
  28. (* Bit <BitNr>.                                           *)
  29.  
  30. FUNCTION ClrBit(Zahl: WORD; BitNr: BYTE): WORD;
  31. (* liefert als Ergebnis den Wert von <Zahl> mit gelöschtem*)
  32. (* Bit <BitNr>.                                           *)
  33.  
  34. FUNCTION BitMaske(Min,Breite: BYTE): WORD;
  35. (* liefert eine Zahl, in der <Breite> Bits von Bit <Min>  *)
  36. (* an gesetzt sind.                                       *)
  37.  
  38. FUNCTION BitGrp(Zahl: WORD; Min,Breite: BYTE): WORD;
  39. (* liefert den Wert der <Breite> Bits, die in <Zahl> ab   *)
  40. (* <Min> stehen.                                          *)
  41.  
  42. FUNCTION RoL(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
  43. (* liefert den Wert der ersten <Laenge> Bits von <Zahl>,  *)
  44. (* nachdem diese <Anzahl>-mal nach links rotiert wurden.  *)
  45.  
  46. FUNCTION RoR(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
  47.  
  48. (* liefert den Wert der ersten <Laenge> Bits von <Zahl>,  *)
  49. (* nachdem diese <Anzahl>-mal nach rechts rotiert wurden. *)
  50.  
  51. FUNCTION IntStr(Zahl: WORD; Basis,Laenge: BYTE): string;
  52. (* liefert einen String, der die Darstellung von <Zahl>   *)
  53. (* zur Basis <Basis> enthält. Ist <Basis> kleiner als 2   *)
  54. (* oder größer als 16, dann wird Zahl byteweise in ASCII- *)
  55. (* Zeichen umgewandelt. Das Ergebnisstring hat mindestens *)
  56. (* die Länge <Laenge>. Gegebenfalls werden bei einer      *)
  57. (* Zahlendarstellung entsprechend viele Nullen ergänzt.   *)
  58. (* Bei ASCII-Darstellung werden Leerzeichen eingefügt.    *)
  59.  
  60. FUNCTION IntVal(Zahl: string; Basis: BYTE;
  61.                                    var Code: INTEGER): WORD;
  62. (* liefert den Wert von <Zahl> zurück, das eine Zahl in   *)
  63. (* der Darstellung zur Basis <Basis> enthält. Enthält     *)
  64. (* <Zahl> falsche (z. B. führende Leerzeichen) oder zu    *)
  65. (* viele Ziffern, so liefert Code die Position des ersten *)
  66. (* falschen Zeichens zurück. Bei einer erfolgreichen      *)
  67. (* Übersetzung ist <Code> Null. Ist <Basis> kleiner als 2 *)
  68. (* oder größer als 16, dann wird der ASCII-Code der       *)
  69. (* Zeichen als Ziffern genutzt (siehe IntStr).            *)
  70.  
  71.  
  72. IMPLEMENTATION
  73.  
  74. FUNCTION TestBit(Zahl: WORD; BitNr: BYTE): BOOLEAN;
  75. BEGIN
  76.   TestBit:=(((Zahl SHR BitNr) AND 1)=1)
  77. END;
  78.  
  79. FUNCTION SetBit(Zahl: WORD; BitNr: BYTE): WORD;
  80. BEGIN
  81.   SetBit:=Zahl OR (1 SHL BitNr)
  82. END;
  83.  
  84. FUNCTION ClrBit(Zahl: WORD; BitNr: BYTE): WORD;
  85. BEGIN
  86.   ClrBit:=Zahl AND NOT (1 SHL BitNr)
  87. END;
  88.  
  89. FUNCTION BitMaske(Min,Breite: BYTE): WORD;
  90. VAR LV      : BYTE;
  91.     Ergebnis: WORD;
  92. BEGIN
  93.   Ergebnis:=0;
  94.   FOR LV:=1 TO Breite DO Ergebnis:=Ergebnis SHL 1+1;
  95.   BitMaske:=Ergebnis SHL Min
  96. END;
  97.  
  98. FUNCTION BitGrp(Zahl: WORD; Min,Breite: BYTE): WORD;
  99. BEGIN
  100.   BitGrp:=(Zahl AND BitMaske(Min,Breite)) SHR Min
  101. END;
  102.  
  103. FUNCTION RoL(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
  104. VAR LV     : BYTE;
  105.     Max,Inv: WORD;
  106. BEGIN
  107.   Zahl:=Zahl AND BitMaske(0,Laenge);
  108.   Max:=SetBit(0,pred(Laenge));
  109.   Inv:=NOT Max;
  110.   FOR LV:=1 TO Anzahl DO
  111.     IF Zahl AND Max > 0 THEN Zahl:=(Zahl AND Inv) SHL 1+1
  112.     ELSE Zahl:=Zahl SHL 1;
  113.     RoL:=Zahl
  114. END;
  115.  
  116. FUNCTION RoR(Zahl: WORD; Laenge,Anzahl: BYTE): WORD;
  117. VAR LV : BYTE;
  118.     Max: WORD;
  119. BEGIN
  120.   Zahl:=Zahl AND BitMaske(0,Laenge);
  121.   Max:=SetBit(0,pred(Laenge));
  122.   FOR LV:=1 TO Anzahl DO
  123.     Zahl:=(Zahl SHR 1) OR (Zahl AND 1)*Max;
  124.   RoR:=Zahl
  125. END;
  126.  
  127.  
  128. CONST Ziffer: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  129.  
  130. FUNCTION IntStr(Zahl: WORD; Basis,Laenge: BYTE): string;
  131. VAR InsChar : CHAR;
  132.     Ergebnis: string;
  133. BEGIN
  134.   Ergebnis:='';
  135.   IF (Basis>16) OR (Basis<2) THEN BEGIN
  136.     REPEAT
  137.       Ergebnis:=char(Zahl AND $FF)+Ergebnis;
  138.       Zahl:=Zahl SHR 8
  139.     UNTIL Zahl=0;
  140.     InsChar:=' '
  141.   END ELSE BEGIN
  142.     REPEAT
  143.       Ergebnis:=Ziffer[Zahl MOD Basis]+Ergebnis;
  144.       Zahl:=Zahl DIV Basis
  145.     UNTIL Zahl=0;
  146.     InsChar:='0'
  147.   END;
  148.   WHILE Laenge>length(Ergebnis) DO
  149.     Ergebnis:=InsChar+Ergebnis;
  150.   IntStr:=Ergebnis;
  151. END;
  152.  
  153. FUNCTION IntVal(Zahl: string; Basis: BYTE;
  154.                                    VAR Code: integer): WORD;
  155. CONST WMax = 65535;
  156. VAR   Ergebnis: longint;
  157.       Zif     : BYTE;
  158. BEGIN
  159.   Ergebnis:=0;
  160.   Code:=0;
  161.   IF (Basis>16) OR (Basis<2) THEN
  162.     WHILE Code<length(Zahl) do BEGIN
  163.       inc(Code);
  164.       Ergebnis:=Ergebnis*256+ord(Zahl[Code]);
  165.       IF Ergebnis>WMax THEN BEGIN
  166.         IntVal:=0;
  167.         EXIT;
  168.       END;
  169.     END
  170.   ELSE
  171.     WHILE Code<length(Zahl) DO BEGIN
  172.       inc(Code);
  173.       Zif:=pos(Zahl[Code],Ziffer);
  174.       Ergebnis:=Ergebnis*Basis+pred(Zif);
  175.       IF (Ergebnis>WMax)OR(Zif>Basis) OR (Zif=0) THEN BEGIN
  176.         IntVal:=0;
  177.         EXIT;
  178.       END;
  179.     END;
  180.   Code:=0;
  181.   IntVal:=Ergebnis
  182. END;
  183.  
  184. END.
  185. (* ------------------------------------------------------ *)
  186.