В Delphi можно преобразовать строку в набор

Question

Например,

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

, конечно, там должно быть что-то вроде typeinfo, но вы понимаете.Я использую Delphi 2007.

Answer 1

проверьте этот код, это не совсем тот синтаксис, который вы предлагаете, но он работает, устанавливая значение набора из строки.

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 2

Также см. Мой старый пост: SetToString, StringToSet для решения (Delphi 2007, IIRC) без необходимости в опубликованном свойстве 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;

Пример использования:

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;

Answer 3

У вас уже есть правильное имя функции - 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;

(1), потому что изначально borland ограничивал это семейство функций указателями PropInfo, а встроенная функция TypeInfo () возвращает нетипизированный указатель, следовательно, typecast

(2) для приведения типов требуется, чтобы типы были одинакового размера, поэтому ссылки и разыменования на разные типы (TFontStyles - это байт)

---

Особенность Nitpicker: (3) Этот фрагмент работает из коробки в D2010 +. В более ранних версиях требовалось отсутствие зависимости, а именно - перегрузка StringToSet(TypeInfo: PTypeInfo; ... (см. Ссылку на docwiki выше). Эту проблему можно решить путем копирования (да, но TTypeInfo является более низкой, чем TPropInfo) исходной функцией и выполнением 2 (двух) незначительных правок. По понятным причинам я не собираюсь публиковать защищенный авторским правом код, но вот соответствующий 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}