verschiedene Sets an Prozedur übergeben

[negaH]

Mit Strings könnte das dann so aussehen

Delphi-Quellcode:

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.

Benutzt wird es dann so

Delphi-Quellcode:

uses MyUnit;

var
  A: TSetA;
  B: TSetB;
begin

  SetAsString(A, '[ta1,ta3,ta5]');
  SetAsString(B, 'tb2,tb4');

  ShowMessage( GetAsString(A) );
  ShowMessage( GetAsString(B) );
end;

Ich empfehle dir mit überladenen Prozeduren zu arbeiten und so wie oben die Zugriffe lokal zu kapseln. Das führt dann dazu das diese Unit als Schnittstelle in deinem Program absolut sauber ist, ohne das man extern noch unsauber casten muß.

Je nach Größe deiner Mengen musst du intern entsprechend casten. Es gibt 3 ordinale Typen von Sets in Delphi. Set mit <= 8 Elementen müssen nach Byte casted werden, Sets mit <= 16 Elementen nach Word und Sets mit <= 32 nach Cardinal. Größere Mengen werden im obigen Source nicht unterstützt !!



Gruß Hagen