unit MyUnit;
uses .....;
interface
type
TA = (ta1, ta2, ta3, ta4, ta5);
TSetA =
set of TA;
TB = (tb1, tb2, tb3, tb4, tb5);
TSetB =
set of TB;
function GetAsString(Value: TSetA):
String;
overload;
function GetAsString(Value: TSetB):
String;
overload;
procedure SetAsString(
var Data: TSetA;
const Value:
String);
overload;
procedure SetAsString(
var Data: TSetB;
const Value:
String);
overload;
implementation
uses SysUtils, TypInfo, .....;
procedure CheckType(Info: PTypeData);
begin
Assert(Info.MaxValue - Info.MinValue <= 32, '
Set ist zu groß');
end;
function GetAsString(Data: Cardinal; Info: PTypeInfo):
String;
overload;
var
T: PTypeInfo;
P: PTypeData;
I: LongInt;
begin
T := GetTypeData(Info).CompType^;
P := GetTypeData(T);
CheckType(P);
for I := P.MinValue
to P.MaxValue
do
if Data
and (1
shl I) <> 0
then
Result := Result + GetEnumName(T, I) + '
,';
SetLength(Result, Length(Result) -1);
end;
function SetAsString(Value:
String; Info: PTypeInfo): Cardinal;
overload;
function NextWord(
var C: PChar):
String;
const
cSep = ['
,', '
;', '
', '
[', '
]', '
{', '
}', '
(', '
)'];
var
I: Integer;
begin
while C^
in cSep
do Inc(C);
I := 0;
while not (C[I]
in cSep + [#0])
do Inc(I);
SetString(Result, C, I);
Inc(C, I);
end;
var
T: PTypeInfo;
N:
String;
V: Integer;
C: PChar;
begin
Result := 0;
T := GetTypeData(Info).CompType^;
CheckType(GetTypeData(T));
C := PChar(Value);
while True
do
begin
N := NextWord(C);
if N = '
'
then Break;
V := GetEnumValue(T, N);
if V < 0
then raise Exception.CreateFmt('
Ungültes Element "%s" im Set', [N]);
Result := Result
or (1
shl V);
end;
end;
function GetAsString(Value: TSetA):
String;
overload;
begin
Result := GetAsString(Byte(Value), TypeInfo(TSetA));
end;
function GetAsString(Value: TSetB):
String;
overload;
begin
Result := GetAsString(Byte(Value), TypeInfo(TSetB));
end;
procedure SetAsString(
var Data: TSetA;
const Value:
String);
overload;
begin
Byte(Data) := SetAsString(Value, TypeInfo(TSetA));
end;
procedure SetAsString(
var Data: TSetB;
const Value:
String);
overload;
begin
Byte(Data) := SetAsString(Value, TypeInfo(TSetB));
end;
end.