In Delphi can a string be converted to a set

Question

For instance

Font.Style = StringToSet('[fsBold, fsUnderline]');

of course there would need to be some typeinfo stuff in there, but you get the idea. I'm using Delphi 2007.

Answer 1

You have right function name already - StringToSet. However, usage is tricky:

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;

(1) because initially borland limited this function family to PropInfo pointers and TypeInfo() intrinsic returns untyped pointer, hence the typecast

(2) typecasting requires types to be of same size, hence the referencing and dereferencing to different type (TFontStyles is a Byte)

---

Nitpicker special: (3) This snippet works out of the box in D2010+. Earlier versions has required dependency missing - namely StringToSet(TypeInfo: PTypeInfo; ... overload (see docwiki link above). This problem is solvable by copypasting (yeah, but TTypeInfo is lower-level than TPropInfo) original function and doing 2 (two) minor edits. By obvious reasons i'm not going to publish copyrighted code, but here is the relevant diff:

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}

Answer 2

check this code, is not exactly the same syntax which you propose , but works setting the value of a set from a string.

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;

Answer 3

Also see my old post: SetToString, StringToSet for a solution (Delphi 2007, IIRC) without a need for published property RTTI:

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;

Example usage:

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;