This type implements arbitrarily sized bit sets.
type
TBitSet = record
private
FBitCount: Integer;
FSets: array of set of 0..255;
class function SetCount(BitCount: Integer): Integer; static;
procedure MakeUnique;
procedure GetSetIndexAndBitIndex(Bit: Integer; out SetIndex, BitIndex: Integer);
function GetIsEmpty: Boolean;
procedure SetBitCount(Value: Integer);
function GetSize: Integer;
public
class operator In(const Bit: Integer; const BitSet: TBitSet): Boolean;
class operator Equal(const bs1, bs2: TBitSet): Boolean;
class operator NotEqual(const bs1, bs2: TBitSet): Boolean;
class function SizeOfNativeSet(BitCount: Integer): Integer; static;
property BitCount: Integer read FBitCount write SetBitCount;
property Size: Integer read GetSize;
property IsEmpty: Boolean read GetIsEmpty;
procedure Clear;
procedure IncludeAll;
procedure Include(const Bit: Integer);
procedure Exclude(const Bit: Integer);
end;
{ TBitSet }
procedure TBitSet.MakeUnique;
begin
// this is used to implement copy-on-write so that the type behaves like a value
SetLength(FSets, Length(FSets));
end;
procedure TBitSet.GetSetIndexAndBitIndex(Bit: Integer; out SetIndex, BitIndex: Integer);
begin
Assert(InRange(Bit, 0, FBitCount-1));
SetIndex := Bit shr 8; // shr 8 = div 256
BitIndex := Bit and 255; // and 255 = mod 256
end;
function TBitSet.GetIsEmpty: Boolean;
var
i: Integer;
begin
for i := 0 to High(FSets) do begin
if FSets[i]<>[] then begin
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure TBitSet.SetBitCount(Value: Integer);
var
Bit, SetIndex, BitIndex: Integer;
begin
if (Value<>FBitCount) or not Assigned(FSets) then begin
Assert(Value>=0);
FBitCount := Value;
SetLength(FSets, SetCount(Value));
if Value>0 then begin
(* Ensure that unused bits are cleared, necessary give the CompareMem call in Equal. This also
means that state does not persist when we decrease and then increase BitCount. For instance,
consider this code:
var
bs: TBitSet;
...
bs.BitCount := 2;
bs.Include(1);
bs.BitCount := 1;
bs.BitCount := 2;
Assert(not (1 in bs)); *)
GetSetIndexAndBitIndex(Value - 1, SetIndex, BitIndex);
for Bit := BitIndex + 1 to 255 do begin
System.Exclude(FSets[SetIndex], Bit);
end;
end;
end;
end;
function TBitSet.GetSize: Integer;
begin
Result := Length(FSets)*SizeOf(FSets[0]);
end;
class function TBitSet.SetCount(BitCount: Integer): Integer;
begin
Result := (BitCount + 255) shr 8; // shr 8 = div 256
end;
class function TBitSet.SizeOfNativeSet(BitCount: Integer): Integer;
begin
Result := (BitCount + 7) shr 3; // shr 3 = div 8
end;
class operator TBitSet.In(const Bit: Integer; const BitSet: TBitSet): Boolean;
var
SetIndex, BitIndex: Integer;
begin
BitSet.GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex);
Result := BitIndex in BitSet.FSets[SetIndex];
end;
class operator TBitSet.Equal(const bs1, bs2: TBitSet): Boolean;
begin
Result := (bs1.FBitCount=bs2.FBitCount)
and CompareMem(Pointer(bs1.FSets), Pointer(bs2.FSets), bs1.Size);
end;
class operator TBitSet.NotEqual(const bs1, bs2: TBitSet): Boolean;
begin
Result := not (bs1=bs2);
end;
procedure TBitSet.Clear;
var
i: Integer;
begin
MakeUnique;
for i := 0 to High(FSets) do begin
FSets[i] := [];
end;
end;
procedure TBitSet.IncludeAll;
var
i: Integer;
begin
for i := 0 to BitCount-1 do begin
Include(i);
end;
end;
procedure TBitSet.Include(const Bit: Integer);
var
SetIndex, BitIndex: Integer;
begin
MakeUnique;
GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex);
System.Include(FSets[SetIndex], BitIndex);
end;
procedure TBitSet.Exclude(const Bit: Integer);
var
SetIndex, BitIndex: Integer;
begin
MakeUnique;
GetSetIndexAndBitIndex(Bit, SetIndex, BitIndex);
System.Exclude(FSets[SetIndex], BitIndex);
end;
set of (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday)takes one byte (with a bit spare) and can be cast to a byte. It's actually the same as Uwe Raabe's answer, except that the values are named whatever you like, rather than numbers.