集合型を保存

解決

レッド 2005-08-09 07:58:17 No: 16940

集合型の変数を保存したいのですが，集合型を数値に変換することはできるのでしょうか？またできない場合，簡単に集合型を保存する方法があれば教えてください．

よろしくお願いします．

B 2005-08-09 09:45:00 No: 16941

procedure TForm1.Button1Click(Sender: TObject);
type Ta =( aa,bb,cc);                   //順序型を定義
     Tas= set of ta;                    //集合型を定義
var a:Tas;                              //集合型変数
    v:array[0..31] of byte absolute a;  //集合型がとり得る最大値
                                        //32Byteの配列を集合型変数と
                                        //同一アドレスに割り当て
    Ix:integer;                         //制御変数
begin
  for Ix:=0 to Sizeof(Tas) -1 do
    // V[ix] を保存する手続きを定義。V[Ix]はByte型の数値;
end;

レッド 2005-08-09 22:33:42 No: 16942

できました！ありがとうございます．
absoluteなんて知りませんでした．

Fusa 2005-08-12 10:46:59 No: 16943

解決しているようですが
集合型や列挙型と文字列相互変換関数を
乗せておきます。

test○○の中身を見ると
EnumIntToString/StringToEnumInt/SetToString/StringToSetOut
それぞれの使い方がわかるでしょう。

uses
TypInfo;

//列挙型→文字列
function EnumIntToString(Info: PTypeInfo; Value: Integer): String; forward;
//文字列→列挙型
function StringToEnumInt(Info: PTypeInfo; Value: String): Integer; forward;
//集合型→文字列
function SetToString(Info: PTypeInfo; const Value;
Brackets: Boolean = True): string; forward;
//文字列→集合型
procedure StringToSetOut(Info: PTypeInfo; const Value: string; out Result); forward;

procedure Check(A, B: Variant);
begin
  if not(A = B) then
  begin
    raise Exception.Create('エラーです ' + A + ':' + B);
  end;
end;

type
  TEnumNumber01 = 0..7;
  TEnumNumbers01 = set of TEnumNumber01;
  TEnumNumber02 = 0..15;
  TEnumNumbers02 = set of TEnumNumber02;
  TEnumNumber03 = 0..23;
  TEnumNumbers03 = set of TEnumNumber03;
  TEnumNumber04 = 0..31;
  TEnumNumbers04 = set of TEnumNumber04;
  TEnumNumber05 = 0..39;
  TEnumNumbers05 = set of TEnumNumber05;
  TEnumNumber06 = 0..47;
  TEnumNumbers06 = set of TEnumNumber06;
  TEnumNumber07 = 0..55;
  TEnumNumbers07 = set of TEnumNumber07;
  TEnumNumber08 = 0..63;
  TEnumNumbers08 = set of TEnumNumber08;
  TEnumNumber09 = 0..71;
  TEnumNumbers09 = set of TEnumNumber09;
  TEnumNumber10 = 0..79;
  TEnumNumbers10 = set of TEnumNumber10;
  TEnumNumber11 = 0..87;
  TEnumNumbers11 = set of TEnumNumber11;
  TEnumNumber12 = 0..95;
  TEnumNumbers12 = set of TEnumNumber12;
  TEnumNumber13 = 0..101;
  TEnumNumbers13 = set of TEnumNumber13;
  TEnumNumber14 = 0..111;
  TEnumNumbers14 = set of TEnumNumber14;

procedure testSizeOfEnum;
begin
  Check( 1, SizeOf(TEnumNumbers01));
  Check( 2, SizeOf(TEnumNumbers02));
  Check( 4, SizeOf(TEnumNumbers03));
  Check( 4, SizeOf(TEnumNumbers04));
  Check( 5, SizeOf(TEnumNumbers05));
  Check( 6, SizeOf(TEnumNumbers06));
  Check( 7, SizeOf(TEnumNumbers07));
  Check( 8, SizeOf(TEnumNumbers08));
  Check( 9, SizeOf(TEnumNumbers09));
  Check(10, SizeOf(TEnumNumbers10));
  Check(11, SizeOf(TEnumNumbers11));
  Check(12, SizeOf(TEnumNumbers12));
  Check(13, SizeOf(TEnumNumbers13));
  Check(14, SizeOf(TEnumNumbers14));
end;

procedure testEnumValue;
var
  EnumNumbers: TEnumNumbers01;
begin
  EnumNumbers := [];
  Check(0, Byte(EnumNumbers));
  EnumNumbers := [0];
  Check(1, Byte(EnumNumbers));
  EnumNumbers := [1];
  Check(2, Byte(EnumNumbers));
  EnumNumbers := [0,1];
  Check(3, Byte(EnumNumbers));
  EnumNumbers := [2];
  Check(4, Byte(EnumNumbers));
  EnumNumbers := [0,2];
  Check(5, Byte(EnumNumbers));
  EnumNumbers := [1,2];
  Check(6, Byte(EnumNumbers));
  EnumNumbers := [0,1,2];
  Check(7, Byte(EnumNumbers));
end;

function EnumIntToString(Info: PTypeInfo; Value: Integer): String;
var
  EnumMin, EnumMax: Integer;
  TypeData: PTypeData;
begin
  TypeData := GetTypeData(Info);
  EnumMin := TypeData.MinValue;
  EnumMax := TypeData.MaxValue;

  if (EnumMin <= Value) and (Value <= EnumMax) then
  begin
    Result := GetEnumName(Info, Value);
  end else
  begin
    raise EConvertError.Create(IntToStr(Value)+' 変換できない値です');
  end;
end;

function StringToEnumInt(Info: PTypeInfo; Value: String): Integer;
var
  EnumMin, EnumMax: Integer;
  TypeData: PTypeData;
begin
  TypeData := GetTypeData(Info);
  EnumMin := TypeData.MinValue;
  EnumMax := TypeData.MaxValue;

Result := GetEnumValue(Info, Value);

  if not( (EnumMin <= Result) and (Result <= EnumMax) ) then
  begin
    raise EConvertError.Create(IntToStr(Result)+' 変換できない値です');
  end;
end;

type
TMyEnum = (mrOne, mrTwo, mrThree, mrFour);

procedure testEnumIntToString;
var
  Flag: Boolean;
begin
  Check('mrOne', EnumIntToString(TypeInfo(TMyEnum), Ord(mrOne)));
  Check('mrTwo', EnumIntToString(TypeInfo(TMyEnum), Ord(mrTwo)));
  Check('mrThree', EnumIntToString(TypeInfo(TMyEnum), Ord(mrThree)));
  Check('mrFour', EnumIntToString(TypeInfo(TMyEnum), Ord(mrFour)));

  Flag := False;
  try
    Check('mrFour', EnumIntToString(TypeInfo(TMyEnum), Ord(6)));
  except
    on EConvertError do
      Flag := True;
  end;
  Check(True, Flag);
end;

procedure testStringToEnumInt;
var
  Flag: Boolean;
begin
  Check(mrOne, TMyEnum(StringToEnumInt(TypeInfo(TMyEnum), 'mrOne')));
  Check(mrTwo, TMyEnum(StringToEnumInt(TypeInfo(TMyEnum), 'mrTwo')));
  Check(mrThree, TMyEnum(StringToEnumInt(TypeInfo(TMyEnum), 'mrThree')));
  Check(mrFour, TMyEnum(StringToEnumInt(TypeInfo(TMyEnum), 'mrFour')));

  Flag := False;
  try
    Check(mrFour, TMyEnum(StringToEnumInt(TypeInfo(TMyEnum), 'mrFive')));
  except
    on EConvertError do
      Flag := True;
  end;
  Check(True, Flag);
end;

function SetToString(Info: PTypeInfo; const Value;
Brackets: Boolean = True): string;
type TMaxSet = set of Byte;
var
  ElemTypeInfo: PTypeInfo;
  ElemTypeData: PTypeData;
  I: Integer;
  SetValue: TMaxSet;
begin
  Result := '';
  SetValue := [];

ElemTypeInfo := GetTypeData(Info)^.CompType^;
ElemTypeData := GetTypeData(ElemTypeInfo);

  for I := ElemTypeData.MinValue to ElemTypeData.MaxValue do
  begin
    if I in TMaxSet(Value) then
    begin
      if Result <> '' then
        Result := Result + ',';
      Result := Result + GetEnumName(ElemTypeInfo, I);
      Include(SetValue, I);
    end;
  end;

if Brackets then
Result := '[' + Result + ']';
end;

procedure StringToSetOut(Info: PTypeInfo; const Value: string; out Result);

  function NextWord(var P: PChar): string;
  var I: Integer;
  begin
    while P^ in [',', ' ', '[', ']'] do Inc(P);
    I := 0; while P[I] in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(I);
    SetString(Result, P, I); Inc(P, I);
  end;

type TMaxSet = set of Byte;
var
  ElemTypeInfo: PTypeInfo;
  ElemTypeData: PTypeData;
  P: PChar;
  EnumName: string; I, ElemValue: Integer;
begin

  ElemTypeInfo := GetTypeData(Info)^.CompType^;
  ElemTypeData := GetTypeData(ElemTypeInfo);
  for I := ElemTypeData^.MinValue to ElemTypeData^.MaxValue do Exclude(TMaxSet(Result), I);
  P := PChar(Value);
  repeat
    EnumName := NextWord(P);
    if EnumName = '' then Break;
    ElemValue := StringToEnumInt(ElemTypeInfo, EnumName);
    Include(TMaxSet(Result), ElemValue);
  until False;
end;

type
TMyEnums = set of TMyEnum;

procedure testSetToString;
var
  MyEnums: TMyEnums;
begin
  MyEnums := [mrThree];
  Check( '[mrThree]', SetToString(TypeInfo(TMyEnums), MyEnums) );
  MyEnums := [mrOne] + [mrTwo];
  Check( '[mrOne,mrTwo]', SetToString(TypeInfo(TMyEnums), MyEnums) );
  MyEnums := [];
  Check( '[]', SetToString(TypeInfo(TMyEnums), MyEnums) );
end;

procedure testSetToString2;
var
  Enums01: TEnumNumbers01;
  Enums02: TEnumNumbers02;
  Enums03: TEnumNumbers03;
  Enums04: TEnumNumbers04;
  Enums05: TEnumNumbers05;
  Enums06: TEnumNumbers06;
  Enums07: TEnumNumbers07;
  Enums08: TEnumNumbers08;
begin
  Enums01 := [0, 1, 7];
  Check('[0,1,7]', SetToString(TypeInfo(TEnumNumbers01), Enums01));

Enums02 := [0, 1, 15];
Check('[0,1,15]', SetToString(TypeInfo(TEnumNumbers02), Enums02));

Enums03 := [0, 1, 23];
Check('[0,1,23]', SetToString(TypeInfo(TEnumNumbers03), Enums03));

Enums04 := [0, 1, 31];
Check('[0,1,31]', SetToString(TypeInfo(TEnumNumbers04), Enums04));

Enums05 := [0, 1, 39];
Check('[0,1,39]', SetToString(TypeInfo(TEnumNumbers05), Enums05));

Enums06 := [0, 1, 47];
Check('[0,1,47]', SetToString(TypeInfo(TEnumNumbers06), Enums06));

Enums07 := [0, 1, 55];
Check('[0,1,55]', SetToString(TypeInfo(TEnumNumbers07), Enums07));

Enums08 := [0, 1, 63];
Check('[0,1,63]', SetToString(TypeInfo(TEnumNumbers08), Enums08));
end;

procedure testStringToSetOut;
var
  Enums01A, Enums01B: TEnumNumbers01;
  Enums02A, Enums02B: TEnumNumbers02;
  Enums03A, Enums03B: TEnumNumbers03;
  Enums04A, Enums04B: TEnumNumbers04;
  Enums05A, Enums05B: TEnumNumbers05;
  Enums08A, Enums08B: TEnumNumbers08;
  Enums14A, Enums14B: TEnumNumbers14;
begin
  Enums01A := [0, 1, 7];
  StringToSetOut(TypeInfo(TEnumNumbers01), '[0,1,7]', Enums01B);
  Check(True, Enums01A=Enums01B);

  Enums02A := [0, 1, 15];
  StringToSetOut(TypeInfo(TEnumNumbers02), '[0,1,15]', Enums02B);
  Check(True, Enums02A=Enums02B);

  Enums03A := [0, 1, 23];
  StringToSetOut(TypeInfo(TEnumNumbers03), '[0,1,23]', Enums03B);
  Check(True, Enums03A=Enums03B);

  Enums04A := [0, 1, 31];
  StringToSetOut(TypeInfo(TEnumNumbers04), '[0,1,31]', Enums04B);
  Check(True, Enums04A=Enums04B);

  Enums05A := [0, 1, 39];
  StringToSetOut(TypeInfo(TEnumNumbers05), '[0,1,39]', Enums05B);
  Check(True, Enums05A=Enums05B);

  Enums08A := [0, 1, 63];
  StringToSetOut(TypeInfo(TEnumNumbers08), '[0,1,63]', Enums08B);
  Check(True, Enums08A=Enums08B);

  Enums14A := [0, 1, 111];
  StringToSetOut(TypeInfo(TEnumNumbers14), '[0,1,111]', Enums14B);
  Check(True, Enums14A=Enums14B);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
testEnumValue;
testSizeOfEnum;

testEnumIntToString;
testStringToEnumInt;

testSetToString;
testSetToString2;

testStringToSetOut;
end;

B 2005-08-15 10:13:39 No: 16944

Fusaへ
バグあり。

Fusa 2005-08-16 01:51:38 No: 16945

おや、ありがとうございます。

えっと、
どこにでしょうか...
(^-^;

普通にCheck関数通過しない？

長いソースになって扱いづらくて申し訳ないです。