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（）内部返回无类型指针，因此类型转换

（2）类型转换需要类型大小相同，因此引用和解除引用不同类型（TFontStyles是字节）

Nitpicker special：（3）此代码段在D2010 +中开箱即用。早期版本需要缺少依赖项 - 即StringToSet(TypeInfo: PTypeInfo; ...重载（请参阅上面的docwiki链接）。这个问题可以通过copypasting（是的，但是TTypeInfo比TPropInfo更低级别）原始函数并进行2（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}

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

3 个答案: