集合型を保存 (ID:16943)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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

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;

←解決時は質問者本人がここをチェックしてください。

戻る