在Delphi中可以将字符串转换为集合

uses
 TypInfo;

procedure StringToSet(Const Values,AProperty:string;Instance: TObject);
begin
  if Assigned(GetPropInfo(Instance.ClassInfo, AProperty)) then
     SetSetProp(Instance,AProperty,Values);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  StringToSet(\'[fsBold, fsUnderline, fsStrikeOut]\',\'Style\',Label1.Font);
end;

uses
  SysUtils, TypInfo;

function GetOrdValue(Info: PTypeInfo; const SetParam): Integer;
begin
  Result := 0;

  case GetTypeData(Info)^.OrdType of
    otSByte, otUByte:
      Result := Byte(SetParam);
    otSWord, otUWord:
      Result := Word(SetParam);
    otSLong, otULong:
      Result := Integer(SetParam);
  end;
end;

procedure SetOrdValue(Info: PTypeInfo; var SetParam; Value: Integer);
begin
  case GetTypeData(Info)^.OrdType of
    otSByte, otUByte:
      Byte(SetParam) := Value;
    otSWord, otUWord:
      Word(SetParam) := Value;
    otSLong, otULong:
      Integer(SetParam) := Value;
  end;
end;

function SetToString(Info: PTypeInfo; const SetParam; Brackets: Boolean): AnsiString;
var
  S: TIntegerSet;
  TypeInfo: PTypeInfo;
  I: Integer;
begin
  Result := \'\';

  Integer(S) := GetOrdValue(Info, SetParam);
  TypeInfo := GetTypeData(Info)^.CompType^;
  for I := 0 to SizeOf(Integer) * 8 - 1 do
    if I in S then
    begin
      if Result <> \'\' then
        Result := Result + \',\';
      Result := Result + GetEnumName(TypeInfo, I);
    end;
  if Brackets then
    Result := \'[\' + Result + \']\';
end;

procedure StringToSet(Info: PTypeInfo; var SetParam; const Value: AnsiString);
var
  P: PAnsiChar;
  EnumInfo: PTypeInfo;
  EnumName: AnsiString;
  EnumValue, SetValue: Longint;

  function NextWord(var P: PAnsiChar): AnsiString;
  var
    I: Integer;
  begin
    I := 0;
    // scan til whitespace
    while not (P[I] in [\',\', \' \', #0,\']\']) do
      Inc(I);
    SetString(Result, P, I);
    // skip whitespace
    while P[I] in [\',\', \' \',\']\'] do
      Inc(I);
    Inc(P, I);
  end;

begin
  SetOrdValue(Info, SetParam, 0);
  if Value = \'\' then
    Exit;

  SetValue := 0;
  P := PAnsiChar(Value);
  // skip leading bracket and whitespace
  while P^ in [\'[\',\' \'] do
    Inc(P);
  EnumInfo := GetTypeData(Info)^.CompType^;
  EnumName := NextWord(P);
  while EnumName <> \'\' do
  begin
    EnumValue := GetEnumValue(EnumInfo, EnumName);
    if EnumValue < 0 then
    begin
      SetOrdValue(Info, SetParam, 0);
      Exit;
    end;
    Include(TIntegerSet(SetValue), EnumValue);
    EnumName := NextWord(P);
  end;
  SetOrdValue(Info, SetParam, SetValue);
end;

var
  A: TAlignSet;
  S: AnsiString;
begin
  // set to string
  A := [alClient, alLeft, alTop];
  S := SetToString(TypeInfo(TAlignSet), A, True);
  ShowMessage(Format(\'%s ($%x)\', [S, Byte(A)]));

  // string to set
  S := \'[alNone, alRight, alCustom]\';
  StringToSet(TypeInfo(TAlignSet), A, S);
  ShowMessage(Format(\'%s ($%x)\', [SetToString(TypeInfo(TAlignSet), A, True), Byte(A)]));
end;

StringToSet

procedure TForm1.FormClick(Sender: TObject);
type PFontStyles = ^TFontStyles;       // typecast helper declaration
var Styles: Integer;                   // receives set bitmap after parsing
{$IF SizeOf(TFontStyles) > SizeOf(Integer)}
{$MESSAGE FATAL \'Panic. RTTI functions will work with register-sized sets only\'}
{$IFEND}
begin
  Styles := StringToSet(               // don\'t forget to use TypInfo (3)
    PTypeInfo(TypeInfo(TFontStyles)),  // this kludge is required for overload (1)
    \'[fsBold, fsUnderline]\'
  );
  Font.Style := PFontStyles(@Styles)^; // hack to bypass strict typecast rules (2)
  Update();                            // let form select amended font into Canvas
  Canvas.TextOut(0, 0, \'ME BOLD! ME UNDERLINED!\');
end;

1c1,2
< function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
---
> {$IF RTLVersion < 21.0}
> function StringToSet(TypeInfo: PTypeInfo; const Value: string): Integer; overload;
37c38
<   EnumInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
---
>   EnumInfo := GetTypeData(TypeInfo)^.CompType^;
47a49
> {$IFEND}