Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save owlsperspective/789572e163754939f5d9 to your computer and use it in GitHub Desktop.
Save owlsperspective/789572e163754939f5d9 to your computer and use it in GitHub Desktop.
要素数が256を超える列挙型の集合型
unit Unit2;
interface
uses
{$IF CompilerVersion >= 23.0}
System.SysUtils;
{$ELSE}
SysUtils;
{$IFEND}
const
BYTE_BIT = 8; // Number of bits in byte
type
{ Base enumeration type }
TFoo = (Foo0 = -1,
Foo1,
Foo2,
Foo3,
Foo4,
Foo5,
FooMax = 256);
// TFooSetX = set of TFoo; // E2028 Sets may have at most 256 elements
{ Set of large enumeration }
PFooSet = ^TFooSet;
TFooSet = record
private
type
TEnumerator = class(TObject)
private
FContainer: PFooSet;
FIndex: Integer;
function GetCurrent: TFoo;
public
constructor Create(Container: PFooSet);
function MoveNext: Boolean;
property Current: TFoo
read GetCurrent;
end;
private
FData: array [0..((Ord(High(TFoo)) - Ord(Low(TFoo)) + 1 + (BYTE_BIT - 1)) div BYTE_BIT) - 1] of Byte;
class procedure CalcOffsets(Value: TFoo; var AOffset: Integer; var ABit: Byte); static;
public
procedure Clear;
procedure Empty;
function IsEmpty: Boolean;
procedure Include(Value: TFoo); overload;
procedure Include(const Values: array of TFoo); overload;
procedure Exclude(Value: TFoo); overload;
procedure Exclude(const Values: array of TFoo); overload;
function &In(Value: TFoo): Boolean;
function ToString(ZeroSuppression: Boolean = True): String;
class function Parse(const Value: String): TFooSet; static;
{$IF CompilerVersion>=24.00}
class operator Implicit(const Values: array of TFoo): TFooSet;
{$IFEND}
class operator Add(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Add(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
class operator Subtract(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Subtract(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
class operator Multiply(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet; overload;
{$IF CompilerVersion>=28.00}
class operator Multiply(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet; overload;
{$IFEND}
class operator LessThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator GreaterThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator Equal(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator NotEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean; overload;
class operator In(lvalue: TFoo; const rvalue: TFooSet): Boolean;
function GetEnumerator: TEnumerator;
end;
implementation
{ TFooSet }
procedure TFooSet.Clear;
begin
Self.Empty;
end;
procedure TFooSet.Empty;
begin
FillChar(FData[0],SizeOf(FData),0);
end;
function TFooSet.IsEmpty: Boolean;
var
Offset: Integer;
begin
Result := False;
for Offset := Low(FData) to High(FData) do
begin
if FData[Offset] <> 0 then
begin
Result := True;
Exit;
end;
end;
end;
procedure TFooSet.Include(Value: TFoo);
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
FData[Offset] := FData[Offset] or Bit;
end;
procedure TFooSet.Include(const Values: array of TFoo);
var
Value: TFoo;
begin
if Length(Values) > 0 then
begin
for Value in Values do
begin
Include(Value);
end;
end;
end;
procedure TFooSet.Exclude(Value: TFoo);
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
FData[Offset] := FData[Offset] and (not Bit);
end;
procedure TFooSet.Exclude(const Values: array of TFoo);
var
Value: TFoo;
begin
for Value in Values do
begin
Exclude(Value);
end;
end;
function TFooSet.&In(Value: TFoo): Boolean;
var
Offset: Integer;
Bit: Byte;
begin
CalcOffsets(Value,Offset,Bit);
Result := (FData[Offset] and Bit) <> 0;
end;
function TFooSet.ToString(ZeroSuppression: Boolean): String;
var
Index: Integer;
Len: Integer;
Offset: Integer;
begin
Result := '';
for Offset := Low(FData) to High(FData) do
begin
Result := IntToHex(FData[Offset],2) + Result;
end;
if ZeroSuppression = True then
begin
Index := 1;
Len := Length(Result);
while (Index < Len) and (Result[Index] = '0') do
begin
Index := Index + 1;
end;
if Index > 1 then
begin
Delete(Result,1,Index - 1);
end;
end;
end;
class function TFooSet.Parse(const Value: String): TFooSet;
var
Offset: Integer;
S: String;
begin
Result.Clear;
S := StringOfChar('0',(SizeOf(Result.FData) * 2) - Length(Value)) + Value;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := StrToInt('$' + Copy(S,(SizeOf(Result.FData) * 2) - (Offset * 2) - 1,2));
end;
end;
{$IF CompilerVersion>=24.00}
class operator TFooSet.Implicit(const Values: array of TFoo): TFooSet;
begin
Result.Clear;
Result.Include(Values);
end;
{$IFEND}
class operator TFooSet.Add(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] or rvalue.FData[Offset];
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Add(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
var
Value: TFoo;
begin
Result := lvalue;
for Value in rvalue do
begin
Result.Include(Value);
end;
end;
{$IFEND}
class operator TFooSet.Subtract(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] and (not rvalue.FData[Offset]);
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Subtract(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
var
Value: TFoo;
begin
Result := lvalue;
for Value in rvalue do
begin
Result.Exclude(Value);
end;
end;
{$IFEND}
class operator TFooSet.Multiply(const lvalue: TFooSet; const rvalue: TFooSet): TFooSet;
var
Offset: Integer;
begin
Result.Clear;
for Offset := Low(Result.FData) to High(Result.FData) do
begin
Result.FData[Offset] := lvalue.FData[Offset] and rvalue.FData[Offset];
end;
end;
{$IF CompilerVersion>=28.00}
class operator TFooSet.Multiply(const lvalue: TFooSet; const rvalue: array of TFoo): TFooSet;
begin
Result := lvalue * TFooSet(rvalue);
end;
{$IFEND}
class operator TFooSet.LessThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] and rvalue.FData[Offset]) <> lvalue.FData[Offset] then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.GreaterThanOrEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] and rvalue.FData[Offset]) <> rvalue.FData[Offset] then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.Equal(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
var
Offset: Integer;
begin
for Offset := Low(lvalue.FData) to High(lvalue.FData) do
begin
if (lvalue.FData[Offset] xor rvalue.FData[Offset]) <> 0 then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
class operator TFooSet.NotEqual(const lvalue: TFooSet; const rvalue: TFooSet): Boolean;
begin
Result := not (lvalue = rvalue);
end;
class operator TFooSet.In(lvalue: TFoo; const rvalue: TFooSet): Boolean;
begin
Result := rvalue.&In(lvalue);
end;
function TFooSet.GetEnumerator: TEnumerator;
begin
Result := TEnumerator.Create(@Self);
end;
class procedure TFooSet.CalcOffsets(Value: TFoo; var AOffset: Integer; var ABit: Byte);
var
RelPos: Integer;
begin
RelPos := Ord(Value) - Ord(Low(TFoo));
AOffset := RelPos div BYTE_BIT;
ABit := 1 shl (RelPos mod BYTE_BIT);
end;
{ TEnumerator }
constructor TFooSet.TEnumerator.Create(Container: PFooSet);
begin
inherited Create;
FIndex := Ord(Low(TFoo)) - 1;
FContainer := Container;
end;
function TFooSet.TEnumerator.MoveNext: Boolean;
begin
while (FIndex < Ord(High(TFoo))) do
begin
FIndex := FIndex + 1;
if FContainer^.&In(TFoo(FIndex)) = True then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
function TFooSet.TEnumerator.GetCurrent: TFoo;
begin
Result := TFoo(FIndex);
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment