uses TypInfo
// 转换字符串为集合，Delphi自带的有BUG
function StringToSet(PropInfo: PTypeInfo; const Value: string): Integer;
var
P: PChar;
EnumName: string;
EnumValue: Longint;
EnumInfo: PTypeInfo;
// grab the next enum name
function NextWord(var P: PChar): string;
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
Result := 0;
if Value = '' then Exit;
P := PChar(Value);
// skip leading bracket and whitespace
while P^ in ['[',' '] do
Inc(P);
EnumInfo := GetTypeData(PropInfo)^.CompType^;
EnumName := NextWord(P);
while EnumName <> '' do
begin
EnumValue := GetEnumValue(EnumInfo, EnumName);
if EnumValue < 0 then
raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyElement, [EnumName]);
Include(TIntegerSet(Result), EnumValue);
EnumName := NextWord(P);
end;
end;
// 转换集合为字符串，Delphi自带的有BUG
function SetToString(P: PTypeInfo; const Value; const Bracks: Boolean): string;
var
I: Integer;
BaseType: PTypeInfo;
begin
Result := '';
BaseType := GetTypeData(P)^.CompType^;
for I := 0 to High(Byte) - 1 do
if I in TIntegerSet(Value) then
Result := Result + GetEnumName(BaseType, I) + ',';
if Result <> '' then
Delete(Result, Length(Result), 2);
if Bracks then Result := Format('[%s]', [Result]);
end;
列出枚举类型的名字？
get names of enumerated values?
// For example, if you have some enum type
{....}
type
TYourEnumType = (One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten);
{....}
{
And you want in run-time to get a string with same value for each of
them (for example, fill the Listbox items with enum values), then you
can use the next procedure:
}
uses TypInfo;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := Ord(Low(TYourEnumType)) to Ord(High(TYourEnumType)) do
ListBox1.Items.Add(GetEnumName(TypeInfo(TYourEnumType), i));
end;
---------------------------------------
字符串转换枚举变量：
uses typinfo;
type
TServerVariables = (svAUTH_PASSWORD, svAUTH_TYPE, svAUTH_USER);
function StrToServerVariable(const Value:String):TServerVariables;
begin
result := TServerVariables(GetEnumValue(TypeInfo(TServerVariables),
Value));
end;
function ServerVariableToStr(const Value:TServerVariables):String;
begin
result := GetEnumName(TypeInfo(TServerVariables), Ord(Value));
end;
---------------------------------------
qsl <qiusonglin@163.net>
上次ePing问过我，我那时也不太清楚，这段也不知他做什么了，先给你一份，:)
转换set类型到字符串，和字符串转到set类型。
一会我再给他发过去，不过不知他还要不要倒是真的。
uses TypInfo;
function GetSetString(P: PTypeInfo; const Value): string;
var
I: Integer;
BaseType: PTypeInfo;
begin
Result := '';
BaseType := GetTypeData(P)^.CompType^;
for I := 0 to High(Byte) - 1 do
if I in TIntegerSet(Value) then
Result := Result + GetEnumName(BaseType, I) + ',';
if Result <> '' then
Delete(Result, Length(Result), 2);
Result := Format('[%s]', [Result]);
end;
procedure GetSetValue(SetType: PTypeInfo; const Value: string; var Result);
var
P, S: PChar;
Len: Integer;
EnumName: string;
EnumType: PTypeInfo;
procedure IncludeResult;
begin
Len := P - S;
SetLength(EnumName, Len);
Move(S^, EnumName[1], Len);
EnumName := Trim(EnumName);
Include(TIntegerSet(Result), GetEnumValue(EnumType, EnumName));
end;
begin
TIntegerSet(Result) := [];
EnumType := GetTypeData(SetType)^.CompType^;
P := PChar(Value);
S := P;
while True do
case P^ of
'[':
begin
Inc(P);
S := P;
end;
',':
begin
IncludeResult;
Inc(P);
S := P;
end;
#0, ']':
begin
IncludeResult;
break;
end;
else
Inc(P);
end;
end;
type
TTest = (test1, test2, test3);
TTests = set of TTest;
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetSetString(TypeInfo(TTests), [test1, test2]);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
V: TTests;
begin
GetSetValue(TypeInfo(TTests), '[test1, test2, test3]', V);
if test1 in V then
ShowMessage('test1 in V');
if test2 in V then
ShowMessage('test2 in V');
if test3 in V then
ShowMessage('test3 in V');
end;