In Delphi can a string be converted to a set
For instance
Font.Style = StringToSet('[fsBold, f开发者_高级运维sUnderline]');
of course there would need to be some typeinfo stuff in there, but you get the idea. I'm using Delphi 2007.
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;
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;
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}
精彩评论