home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PAS_0493 / SETBITS1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-15  |  3KB  |  107 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 357 of 473
  3. From : Rob Green                           1:363/166.0          12 Apr 93  12:24
  4. To   : Dane Walther
  5. Subj : ROTATING BITS
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  -=>Obviously lying, Dane Walther said to Sean Palmer <=-
  8.  
  9.  DW> What if I want to just access a bit?  Say I have a byte, to store
  10.  DW> various access levels (if it does/doesn't have this, that, or the
  11.  DW> other).  How can I
  12.  
  13.  DW> 1)  Access, say, bit 4?
  14.  DW> 2)  Give, say, bit 4, a value of 1?
  15.  
  16. Heres a procedure i wrote to handle all that.  If you need speed, then
  17. i suggest to manually check each bit, rather than use the procedures.
  18.  
  19. (these procedures are based on 1, not 0.  thus each byte is like so:
  20. 87654321   instead of 76543210.  to change to 0 base, change the array to
  21. [0..31] instead of [1..32].)}
  22.  
  23. to set a bit: (b is an integer type, BIT is which bit to set
  24.    b:=b or BIT;   ex: b:=b or 128  (set bit 8)
  25.  
  26. to clear a bit:
  27.    b:=b and not BIT;  ex:b:=b and not 8;  (clears bit 4)
  28.  
  29. to check a bit:
  30.    if b and BIT<>0 then..  ex:if b and 64 then..  (check bit 7)
  31.  
  32. { $tested+ }
  33. -----------------------
  34. const
  35. {This const is used to convert the Bit value to the actual corresponding
  36.  number}
  37.    bit:array[1..32] of longint =
  38.        (1,2,4,8,$10,$20,$40,$80,
  39.         $100,$200,$400,$800,$1000,$2000,$4000,$8000,
  40.         $10000,$20000,$40000,$80000,$100000,$200000,$400000,$800000,
  41.         $1000000,$2000000,$4000000,$8000000,$10000000,$20000000,
  42.         $40000000,$80000000
  43.        );
  44.  
  45. {b is which bit to set(1-32), size is the size of temp.
  46. Use  SIZEOF(TEMP) to get the value, and temp is the actuall integer based
  47. number
  48. returns true if bit set, false if not}
  49.  
  50. function checkbit(b:byte; size:byte; var temp):boolean; {1-32}
  51. var c:boolean;
  52. begin
  53.    c:=false;
  54.    case size of
  55.       1:c:=byte(temp) and bit[b]<>0;     {byte,shortint}
  56.       2:c:=word(temp) and bit[b]<>0;     {word,integer}
  57.       4:c:=longint(temp) and bit[b]<>0;  {longint}
  58.       else writeln('Invalid size');
  59.    end;
  60.    checkbit:=c;
  61. end;
  62.  
  63. {b,size,and temp same as above.  if onoff =true the bit will be set,
  64. else the bit will be cleared}
  65.  
  66. procedure setbit(b:byte; onoff:boolean; size:byte; var temp); {1-32}
  67. begin
  68.    if onoff then
  69.    case size of
  70.       1:byte(temp):=byte(temp) or bit[b];        {byte}
  71.       2:word(temp):=word(temp) or bit[b];        {word}
  72.       4:longint(temp):=longint(Temp) or bit[b];  {longint}
  73.       else writeln('Invalid size');
  74.    end
  75.    else
  76.    case size of
  77.       1:byte(temp):=byte(temp) and not bit[b];   {byte}
  78.       2:word(temp):=word(temp) and not bit[b];   {word}
  79.       4:longint(temp):=longint(Temp) and not bit[b];{longint}
  80.       else writeln('Invalid size');
  81.    end;
  82. end;
  83.  
  84. {this is a sample test program i wrote for you to see how to use the
  85. stuff above}
  86.  
  87. var i:longint; j:byte;
  88. begin
  89.    i:=0;
  90.    setbit(4,true,sizeof(i),i);  {8}
  91.    writeln(i);
  92.    setbit(9,true,sizeof(i),i);  {256+8 = 264}
  93.    writeln(i);
  94.    setbit(9,false,sizeof(i),i); {8}
  95.    writeln(i);
  96.    setbit(20,true,sizeof(i),i); { $80000+8 = $80008}
  97.    writeln(i);
  98.    for i:=65550 to 65575 do
  99.    begin
  100.       write(i:8,' = ');
  101.       for j:=32 downto 1 do {to print right}
  102.          if checkbit(j,sizeof(i),i) then write('1') else write('0');
  103.       writeln;
  104.    end;
  105.  
  106. end.
  107. { $tested- }