AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

verschiedene Sets an Prozedur übergeben

Ein Thema von Angel4585 · begonnen am 5. Sep 2006 · letzter Beitrag vom 6. Sep 2006
Antwort Antwort
Benutzerbild von negaH
negaH

Registriert seit: 25. Jun 2003
Ort: Thüringen
2.950 Beiträge
 
#1

Re: verschiedene Sets an Prozedur übergeben

  Alt 6. Sep 2006, 09:34
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
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:26 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz