verschiedene Sets an Prozedur übergeben

[Angel4585]

Hallo,

wie kann ich folgendes realisieren, ohne eine überladene Prozedur zu verwenden:

Delphi-Quellcode:

type
TMyClass1 = (a,b,c,d);
TMyClass2 = (e,f,g,h);
TMySet1 = set of TMyClass1;
TMySet2 = set of TMyClass2;


procedure DoSomethingWithAnySet(ASet : set);//Was für einen Typ muss de Parameter haben, damit ich jedes Set übergeben kann?
begin

end;

procedure TForm1.Button1Click(Sender : TObject);
var 
  set1 : TMySet1;
  set2 : TMySet2;
begin
DoSomethingWithAnySet(set1);
DoSomethingWithAnySet(set2);
end;

Geht das irgendwie ohne die Prozedur zu überladen?

MfG :angel:

Edit:

Es sollte so funktionieren wie bei Objekten:

Delphi-Quellcode:

type 
 TMyObject1 = class(TObject)
   .
   .
   .
   end;

 TMyObject2 = class(TObject)
   .
   .
   .
   end;

procedure DoSomething(AObject : TObject);//Hier kann ich ja auch beide Objekttypen übergeben
begin

end;

[3_of_8]

Dumme Frage: Wie willst du das dann innerhalb von der Prozedur verarbeiten?

Wenn es nicht wichtig ist, was für ein Set das ist, könntest du evtl einen Pointer oder einen typlosen Parameter übergeben.

[Angel4585]

Zitat:

Zitat von 3_of_8

Dumme Frage: Wie willst du das dann innerhalb von der Prozedur verarbeiten?

Ich brauch das um schauen ob die einzelnen Felder gesetzt sind oder nicht, unabhängig davon was für ein Set das ist.

[Flocke]

Du könntest es intern nach "set of byte" casten, mein erster Ansatz wäre so:

Delphi-Quellcode:

type
  TByteSet = set of byte;

procedure DoSomethingWithAnySet(const ASet);
begin
  if 3 in TByteSet(ASet) then
  begin
    ...
  end;
end;

Dabei werden die Elemente von 0 ausgehend nummeriert. Also kannst du in deinem Beispiel das "a" in TMyClass1 und das "e" in TMyClass2 nicht auseinander halten.

[3_of_8]

Wenn mans gern kompliziert mag, kann man auch einen Pointer/typenlosen Parameter übergeben und dann den Bitvektor verarbeiten.

[Angel4585]

Zitat:

Zitat von Flocke

Du könntest es intern nach "set of byte" casten, mein erster Ansatz wäre so:

Delphi-Quellcode:

type
  TByteSet = set of byte;

procedure DoSomethingWithAnySet(const ASet);
begin
  if 3 in TByteSet(ASet) then
  begin
    ...
  end;
end;

Dabei werden die Elemente von 0 ausgehend nummeriert. Also kannst du in deinem Beispiel das "a" in TMyClass1 und das "e" in TMyClass2 nicht auseinander halten.

klingt gut, werd ich testen sobald ich daheim bin :thumb:

[negaH]

Delphi-Quellcode:

type
TMyClass1 = (a,b,c,d);
TMyClass2 = (e,f,g,h);
TMySet1 = set of TMyClass1;
TMySet2 = set of TMyClass2;

probiere das mal

Delphi-Quellcode:

type
  TMyClass = (a,b,c,d, e,f,g,h);
  TMySet = set of TMyClass;

const
  Set1: TMySet = [a,b,c,d];
  Set2: TMySet = [e,f,g,h];

var
  Set: TMySet;
begin
  if Set * Set1 <> [] then ;
  
end;

Statt also 2 Set zu deklarieren benutzt du nur eine gemeinsamme Menge als Gesamtmenge und dann rechnest du intern mit konstanten Intersections = Teilmengen. Das dürfte konzeptionell sauberer sein, auch performanter und zudem noch Speicher sparender ;)

2 Sets mit 4 Elementen benötigen 2 * 1 Byte und pro Byte werden nur 2 Bits verbraucht -> 2^2 = 4. Bei einem Set mit 8 Elementen braucht man 3 Bits = 2^3 = 8 ergo nur 1 Byte Speicher.

Gruß Hagen

[Angel4585]

ich soll für mein kleines RPG anstatt dem:

Delphi-Quellcode:

TWaffentyp = (wSchwert,wAxt,wStab,wPeitsche,wBogen,wArmbrust,wFlinte,wSpeer);
TSchadenstyp = (sSchnitt,sSchlag,sStich,sSchuss);
TZaubertyp = (zFeuer,zWasser,zErde,zWind,zBlitz,zEis,zLicht,zDunkelheit);
TRassen    = (rMensch,rZwerg,rElf,rDunkelelf,rOrk,rTroll);

das hier machen?

Delphi-Quellcode:

TMegaMultiAllroundTyp = (wSchwert,wAxt,wStab,wPeitsche,wBogen,wArmbrust,wFlinte,wSpeer,
 sSchnitt,sSchlag,sStich,sSchuss,
 zFeuer,zWasser,zErde,zWind,zBlitz,zEis,zLicht,zDunkelheit,
 rMensch,rZwerg,rElf,rDunkelelf,rOrk,rTroll)

:shock: :gruebel:

[Khabarakh]

Was genau soll denn in der Prozedur geschehen? Ich wette, es gibt eine bessere Lösung.

[Angel4585]

das Problem was in der Prozedur passiert ist Thema in nem andern Thread.

Also:
ich möchte quasi den Spielstand speichern. Das ganze wird ein Onlinegame.

also ich habe sowas:

Delphi-Quellcode:

TMyTyp = (tTyp1,tTyp2,tTyp3,tTyp4,...,tTypn);
TMySet = set of TMyTyp;

an die Prozedur will ich jetzt das Set übergeben und in ein Integer verwandeln.
Dabei hat der erste teil den Wert 1, der zweite 2, der dritte 4, der vierte 8 usw.
jetzt schau ich welches der Teile gesetzt ist und bekomm so eine zahl die ich an mein skript schicken kann, in die Datenbank schreiben, wieder auslesen und wieder zurück in das Set wandeln kann.

ich find das schon relativ einfach, die Prozedur habe ich soweit, allerdings muss ich die eben für jedes Set schreiben und da ich ein fauler mensch bin ( :mrgreen: ) möcht ich EINE Prozedur die jedes meiner Sets verarbeiten kann :)

[negaH]

Zitat:

ich soll für mein kleines RPG anstatt dem:
...
das hier machen?
....
Shocked Grübelnd...

Nö. Du hättest es so machen können wie ich es dir gezeigt habe WENN dein obiges Beispiel das du uns gegeben hast das ist was du benötigen tust.

Das was du uns jetzt zeigst ändert die Sache erheblich, allerdings ist eben meine Glaskugel zum Würfel eingeschmolzen worden, sorry das ich also nicht mehr hellsehen kann.


Mache für jedes deiner Sets eine überladene Funktion. Innerhalb dieser Funktion castest du hart deine übergebenen Sets in einen Integer und rufst eine interne Funktion auf die mit einem Integer als Param arbeutet, also so

Delphi-Quellcode:

procedure SaveSet(const Set: TMySet1); overload;
procedure SaveSet(const Set: TMySet2); overload;
procedure SaveSet(const Set: Integer); overload;

procedure SaveSet(const Set: TMySet1);
begin
  SaveSet(Integer(Set));
end;


procedure SaveSet(const Set: TMySet2);
begin
  SaveSet(Integer(Set));
end;


procedure SaveSet(const Set: Integer);
begin
  IniFile.WriteInteger(Set.....);
end;

Was daran ist nun so aufwendig, ich habe 30 Sekunden benötigt.


Gruß Hagen

[Angel4585]

Hagen iss au en schöner Vorschlag, ich habs jetzt aber so:

Delphi-Quellcode:

type
 TConvClass = (c1,c2,c3,c4,c5,c6,c7,c8);
 TConvSet = set of TConvClass;


function TForm1.Test(const ASet):Integer;
var x : TConvClass;
begin
Result:=0;
for x in TConvSet(ASet) do
  begin
  if Ord(x) = 0 then
    Result:=Result+1
  else Result:=Result+Round(Power(Ord(x),2));
  end;
end;

Hier kann ich jedes meiner Sets übergeben.

bei Set of Byte funktioniert das nicht, da scheint alles drin zu sein und ich bekomm anstatt 15 irgendwas wie 20937223 oder so.. also nicht geeignet. Aber jetzt gehts ja.

[negaH]

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
var x : TConvClass;
begin
Result:=0;
for x in TConvSet(ASet) do
  begin
  if Ord(x) = 0 then
    Result:=Result+1
  else Result:=Result+Round(Power(Ord(x),2));
  end;
end;

Also diesen Code könntest du mir mal erklären, also nicht was er macht sondern warum du es so machst ?

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
begin
  Result := Ord(TConvSet(ASet));
end;

sollte nämlich exakt das Gleiche machen.

Gruß Hagen

[Angel4585]

Zitat:

Zitat von negaH

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
var x : TConvClass;
begin
Result:=0;
for x in TConvSet(ASet) do
  begin
  if Ord(x) = 0 then
    Result:=Result+1
  else Result:=Result+Round(Power(Ord(x),2));
  end;
end;

Also diesen Code könntest du mir mal erklären, also nicht was er macht sondern warum du es so machst ?

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
begin
  Result := Ord(TConvSet(ASet));
end;

sollte nämlich exakt das Gleiche machen.

Gruß Hagen

Sagen wir ich bin relativer bis absoluter Programmier-Anfänger und bin eninfach nicht drauf gekommen :duck:
Allerdings hast du en kleinen fehler, bei TConvSet bringt er den Fehler ungülter Typ, wenn ich Byte nehm gehts wieder.

Also ich hab jetzt die folgenden beiden Funktionen:

Delphi-Quellcode:

function SetToInt(const ASet):Integer;
begin
Result:=Ord(Byte(ASet));
end;

Und zum zurückwandeln in ein Set:

function IntToSet(AInt : Integer):TConvSet;
var
  x : Integer;
  LInt : Integer;
begin
Result:=[];
LInt := AInt;
for x := 32 downto 0 do
  if LInt > 0 then
    begin
    if Round(Power(2,x)) <= LInt then
      begin
      LInt:=LInt-Round(Power(2,x));
      Result:=Result + [TConvClass(x)];
      end
    else if (LInt = 1) then
      begin
      LInt:=LInt-1;
      Result:=Result + [TConvClass(0)];
      exit;
      end;
    end;
end;


aufgerufen wird das ganze so:

procedure Test;
var
  testset : TMySet;
  setint : Integer;
begin
testset:=TMySet(IntToSet(5));
setint:=SetToint(testset);
end;

geht die IntToSet Funktion auch einfacher oder ist das OK?

[Angel4585]

Zitat:

Zitat von negaH

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
var x : TConvClass;
begin
Result:=0;
for x in TConvSet(ASet) do
  begin
  if Ord(x) = 0 then
    Result:=Result+1
  else Result:=Result+Round(Power(Ord(x),2));
  end;
end;

Also diesen Code könntest du mir mal erklären, also nicht was er macht sondern warum du es so machst ?

Delphi-Quellcode:

function TForm1.Test(const ASet):Integer;
begin
  Result := Ord(TConvSet(ASet));
end;

sollte nämlich exakt das Gleiche machen.

Gruß Hagen

Sagen wir ich bin relativer bis absoluter Programmier-Anfänger und bin eninfach nicht drauf gekommen :duck:
Allerdings hast du en kleinen fehler, bei TConvSet bringt er den Fehler ungülter Typ, wenn ich Byte nehm gehts wieder.

Also ich hab jetzt die folgenden beiden Funktionen:

Delphi-Quellcode:

function SetToInt(const ASet):Integer;
begin
Result:=Ord(Byte(ASet));
end;

Und zum zurückwandeln in ein Set:

function IntToSet(AInt : Integer):TConvSet;
var
  x : Integer;
  LInt : Integer;
begin
Result:=[];
LInt := AInt;
for x := 32 downto 0 do
  if LInt > 0 then
    begin
    if Round(Power(2,x)) <= LInt then
      begin
      LInt:=LInt-Round(Power(2,x));
      Result:=Result + [TConvClass(x)];
      end
    else if (LInt = 1) then
      begin
      LInt:=LInt-1;
      Result:=Result + [TConvClass(0)];
      exit;
      end;
    end;
end;


aufgerufen wird das ganze so:

procedure Test;
var
  testset : TMySet;
  setint : Integer;
begin
testset:=TMySet(IntToSet(5));
setint:=SetToint(testset);
end;

geht die IntToSet Funktion auch einfacher oder ist das OK?

[negaH]

Delphi-Quellcode:

function IntToSet(Value: INteger): TConvSet;
begin
  Result := TConvSet(Byte(Vale));
end;

Allerdings meine ich das du besser deine Set's als String abspeicherst. Du machst das doch um das in einer Config zu speichern, oder ? Dort wären ja lesbare Strings viel besser, also sowas in der Art

'[c2,c5,c6]'

Du hast nämlich in Delphi über die RTTI und der Unit TypInfo.pas die Möglichkeit deine TConvSet Variable in einen String und zurück zu konvertieren. Dabei enthält dieser String exakt die Elementnamen deines Sets die du in deinem Quelltext als Deklaration verwendet hast.

Gruß Hagen

[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

[Angel4585]

nehee.. moooment :)

Also:

So isses jetzt geplant:

Set -> Integer
Integer -> an php-Skript schicken
in php-Skript evtl. verarbeiten und in DB speichern
später aus DB auslesen, wieder in php-Skript verarbeiten(Schadenstypen für Kämpfe auslesen)
Zahl von Skript zurück ans Programm, dort wieder in Set

da finde ich persönlich das ganze als Zahl schon vorteilhafter

[negaH]

Jo ist ja auch kein Problem ;)

Gruß Hagen