VCL类学习之(三) TBits

1. Unit Classes;
3. { TBits class }
5.   TBits = class
6.   private
7.     FSize: Integer;
8.     FBits: Pointer;
9.     procedure Error;
10.     procedure SetSize(Value: Integer);
11.     procedure SetBit(Index: Integer; Value: Boolean);
12.     function GetBit(Index: Integer): Boolean;
13.   public
14.     destructor Destroy; override;
15.     function OpenBit: Integer;
16.     property Bits[Index: Integer]: Boolean read GetBit write SetBit; default;
17.     property Size: Integer read FSize write SetSize;
18.   end;
20. { TBits }
22. const
23.   BitsPerInt = SizeOf(Integer) * 8;
25. type
26.   TBitEnum = 0..BitsPerInt - 1;
27.   TBitSet = set of TBitEnum;
28.   PBitArray = ^TBitArray;
29.   TBitArray = array[0..4096] of TBitSet;
31. destructor TBits.Destroy;
32. begin
33.   SetSize(0);
34.   inherited Destroy;
35. end;
37. procedure TBits.Error;
38. begin
39.   raise EBitsError.CreateRes(@SBitsIndexError);
40. end;
42. procedure TBits.SetSize(Value: Integer);
43. var
44.   NewMem: Pointer;
45.   NewMemSize: Integer;
46.   OldMemSize: Integer;
48.   function Min(X, Y: Integer): Integer;
49.   begin
50.     Result := X;
51.     if X > Y then Result := Y;
52.   end;
54. begin
55.   if Value <> Size then
56.   begin
57.     if Value < 0 then Error;
58.     NewMemSize := ((Value + BitsPerInt - 1) div BitsPerInt) * SizeOf(Integer);
59.     OldMemSize := ((Size + BitsPerInt - 1) div BitsPerInt) * SizeOf(Integer);
60.     if NewMemSize <> OldMemSize then
61.     begin
62.       NewMem := nil;
63.       if NewMemSize <> 0 then
64.       begin
65.         GetMem(NewMem, NewMemSize);
66.         FillChar(NewMem^, NewMemSize, 0);
67.       end;
68.       if OldMemSize <> 0 then
69.       begin
70.         if NewMem <> nil then
71.           Move(FBits^, NewMem^, Min(OldMemSize, NewMemSize));
72.         FreeMem(FBits, OldMemSize);
73.       end;
74.       FBits := NewMem;
75.     end;
76.     FSize := Value;
77.   end;
78. end;
80. procedure TBits.SetBit(Index: Integer; Value: Boolean); assembler;
81. asm
82.         CMP     Index,[EAX].FSize
83.         JAE     @@Size
85. @@1:    MOV     EAX,[EAX].FBits
86.         OR      Value,Value
87.         JZ      @@2
88.         BTS     [EAX],Index
89.         RET
91. @@2:    BTR     [EAX],Index
92.         RET
94. @@Size: CMP     Index,0
95.         JL      TBits.Error
96.         PUSH    Self
97.         PUSH    Index
98.         PUSH    ECX {Value}
99.         INC     Index
100.         CALL    TBits.SetSize
101.         POP     ECX {Value}
102.         POP     Index
103.         POP     Self
104.         JMP     @@1
105. end;
107. function TBits.GetBit(Index: Integer): Boolean; assembler;
108. asm
109.         CMP     Index,[EAX].FSize
110.         JAE     TBits.Error
111.         MOV     EAX,[EAX].FBits
112.         BT      [EAX],Index
113.         SBB     EAX,EAX
114.         AND     EAX,1
115. end;
117. function TBits.OpenBit: Integer;
118. var
119.   I: Integer;
120.   B: TBitSet;
121.   J: TBitEnum;
122.   E: Integer;
123. begin
124.   E := (Size + BitsPerInt - 1) div BitsPerInt - 1;
125.   for I := 0 to E do
126.     if PBitArray(FBits)^[I] <> [0..BitsPerInt - 1] then
127.     begin
128.       B := PBitArray(FBits)^[I];
129.       for J := Low(J) to High(J) do
130.       begin
131.         if not (J in B) then
132.         begin
133.           Result := I * BitsPerInt + J;
134.           if Result >= Size then Result := Size;
135.           Exit;
136.         end;
137.       end;
138.     end;
139.   Result := Size;
140. end;
142. Description
143. Use TBits to store and access an indefinite number of boolean values. TBits can store as many of boolean values as can fit in available memory, automatically expanding its storage space as needed. If the number of boolean values is limited to 32, the same functionality can be achieved using a 32-bit integer with the bitwise AND (Delphi) or & (C++) and OR (Delphi) or | (C++) operators.