StringSet

[Frank Ranis]

Hallo,

neulich benötigte ich ein Set mit beliebig gemischten Daten , also (Integer , Double , String) ;

Und es sollten beliebig viele Einträge erlaubt sein, aber halt nur ein mal .

Habe im WWW gesucht , wurde aber nicht fündig.

Habe also was gebastelt.

Als Speicher für das Set dient einfach ein String;

var
StringSet:String;

Derzeit gibt es nur ein paar magere Methoden siehe unten:

Die einzelnen Daten werden im String mit einem Semikoln ';' als Delimiter getrennt.
Könnte man auch durch ein anderes Trenn-Zeichen ersetzen .

Derzeit gibt es ein Add- , Sub- und eine Abfrage , ob Wert enthalten ist.

Was noch fehlt wäre eine Schnellzuweisung für Integer- oder Char-Sequenzen, wie man es von derzeitigen Set's kennt.
Also so etwas wie :

x:=['a'..'z','A'..'Z'];
x:=[5..50];

Man könnte auch noch überlegen , ob man die Geschichte mit überladenen Operatoren ausrüstet.
Dann ist es allerdings nicht mehr beliebig unter den verschiedenen Pascalsytemen tauschbar .
Für die String-Suche könnte man noch eine Methode bauen , die eine Groß-Kleinschreibung händelt.

Wer viel Langeweile hat , kann es ja mal erweitern .

Im Anhang noch das Testprog mit Quellen.


Gruß

Frank

Code: Alles auswählen

 
unit T_StringSet;
 
{$MODE Delphi}
 
interface
 
uses SysUtils;
 
procedure add_string_set(wert:Integer; var string_set:string);overload;
procedure add_string_set(wert:double; var string_set:string);overload;
procedure add_string_set(wert:string; var string_set:string);overload;
 
procedure sub_string_set(wert:Integer; var string_set:string);overload;
procedure sub_string_set(wert:double; var string_set:string);overload;
procedure sub_string_set(wert:string; var string_set:string);overload;
 
function wert_in_string_set(wert:integer;string_set:string):boolean;overload;
function wert_in_string_set(wert:double;string_set:string):boolean;overload;
function wert_in_string_set(wert:string;string_set:string):boolean;overload;
 
procedure clear_string_set(var string_set:string);
 
implementation
 
// Löscht StringSet
procedure clear_string_set(var string_set:string);
begin
 string_set:=';';
end;
 
// Integer-Wert an StringSet anfügen
procedure add_string_set(wert:Integer; var string_set:string);
begin
 if pos(';'+inttostr(wert)+';',string_set)=0
  then
   begin
    if length(string_set)=0 then string_set:=';';
    string_set:=string_set+inttostr(wert)+';';
   end;
end;
 
// Float-Wert an StringSet anfügen
procedure add_string_set(wert:double; var string_set:string);
begin
 if pos(';'+floattostr(wert)+';',string_set)=0
  then
   begin
    if length(string_set)=0 then string_set:=';';
    string_set:=string_set+floattostr(wert)+';';
   end;
end;
 
// String an StringSet anfügen
procedure add_string_set(wert:string; var string_set:string);
begin
 if pos(';'+wert+';',string_set)=0
  then
   begin
    if length(string_set)=0 then string_set:=';';
    string_set:=string_set+wert+';';
   end;
end;
 
 
//******************************
 
// Intergerwert aus StringSet ausschneiden
procedure sub_string_set(wert:Integer; var string_set:string);
var po:integer;
    s1,s2:string;
begin
 if pos(';'+inttostr(wert)+';',string_set)>0
  then
   begin
    po:=pos(';'+inttostr(wert)+';',string_set);
    s1:=copy(string_set,1,po);
    s2:=copy(string_set,po+length(';'+inttostr(wert)+';'),length(string_set));
    string_set:=s1+s2;
   end;
end;
 
// Floatwert aus StringSet ausschneiden
procedure sub_string_set(wert:double; var string_set:string);
var po:integer;
    s1,s2:string;
begin
 if pos(';'+floattostr(wert)+';',string_set)>0
  then
   begin
    po:=pos(';'+floattostr(wert)+';',string_set);
    s1:=copy(string_set,1,po);
    s2:=copy(string_set,po+length(';'+floattostr(wert)+';'),length(string_set));
    string_set:=s1+s2;
   end;
end;
 
// String aus StringSet ausschneiden
procedure sub_string_set(wert:string; var string_set:string);
var po:integer;
    s1,s2:string;
begin
 if pos(';'+wert+';',string_set)>0
  then
   begin
    po:=pos(';'+wert+';',string_set);
    s1:=copy(string_set,1,po);
    s2:=copy(string_set,po+length(';'+wert+';'),length(string_set));
    string_set:=s1+s2;
   end;
end;
 
 
//******************************
 
// Integerwert in StringSet finden
function wert_in_string_set(wert:integer;string_set:string):boolean;
begin
 result:=pos(';'+inttostr(wert)+';',string_set)>0;
end;
 
// Floatwert in StringSet finden
function wert_in_string_set(wert:double;string_set:string):boolean;
begin
 result:=pos(';'+floattostr(wert)+';',string_set)>0;
end;
 
// String in StringSet finden
function wert_in_string_set(wert:string;string_set:string):boolean;
begin
 result:=pos(';'+wert+';',string_set)>0;
end;
 
end.                      

[BeniBela]

neulich benötigte ich ein Set mit beliebig gemischten Daten , also (Integer , Double , String) ;

Das benötige ich auch.

Ein großes Problem, dass fpc so wenig Container hat

Als Speicher für das Set dient einfach ein String;

Aber das ist wohl total unbrauchbar

Man braucht Generics und eine Hashmap oder einen Trie/Tree für sowas

[Warf]

Warum nicht einfach sowas verwenden?

Code: Alles auswählen

type
  TDynListType = (dtInt, dtString, dtReal, dtObject);
  TDynListElem = record
    ElemType: TDynListType;
    Elem: Pointer;
  end;

Und dann die Elemente vom Typ TDynListElem einfach in einer Generischen Liste, Baum, Hashmap, etc verwenden?
Über die Information ElemType kann ermittelt werden auf was für einen Typ Elem Zeigt

[Frank Ranis]

Hallo,

neulich benötigte ich ein Set mit beliebig gemischten Daten , also (Integer , Double , String) ;

Das benötige ich auch.

Ein großes Problem, dass fpc so wenig Container hat

Als Speicher für das Set dient einfach ein String;

Aber das ist wohl total unbrauchbar

Man braucht Generics und eine Hashmap oder einen Trie/Tree für sowas

Warum total unbrauchbar ?

Warum nicht einfach sowas verwenden?

Code: Alles auswählen

type
  TDynListType = (dtInt, dtString, dtReal, dtObject);
  TDynListElem = record
    ElemType: TDynListType;
    Elem: Pointer;
  end;

Und dann die Elemente vom Typ TDynListElem einfach in einer Generischen Liste, Baum, Hashmap, etc verwenden?
Über die Information ElemType kann ermittelt werden auf was für einen Typ Elem Zeigt

Hast Du dazu mal ein kleines Beispiel , das wäre Super?
Und würde das auch portierbar sein auf andere Pascalsyseme (z.B. Delphi 5... )

Gruß

Frank

[Mathias]

Vielleicht hilft dies noch weiter: http://wiki.freepascal.org/Variant/de

[Warf]

Hallo,

neulich benötigte ich ein Set mit beliebig gemischten Daten , also (Integer , Double , String) ;

Das benötige ich auch.

Ein großes Problem, dass fpc so wenig Container hat

Als Speicher für das Set dient einfach ein String;

Aber das ist wohl total unbrauchbar

Man braucht Generics und eine Hashmap oder einen Trie/Tree für sowas

Warum total unbrauchbar ?

Warum nicht einfach sowas verwenden?

Code: Alles auswählen

type
  TDynListType = (dtInt, dtString, dtReal, dtObject);
  TDynListElem = record
    ElemType: TDynListType;
    Elem: Pointer;
  end;

Und dann die Elemente vom Typ TDynListElem einfach in einer Generischen Liste, Baum, Hashmap, etc verwenden?
Über die Information ElemType kann ermittelt werden auf was für einen Typ Elem Zeigt

Hast Du dazu mal ein kleines Beispiel , das wäre Super?
Und würde das auch portierbar sein auf andere Pascalsyseme (z.B. Delphi 5... )

Gruß

Frank

Mathias hat recht, ich denke Variants sind hier besser als mein Record (das war nur eine schnell zusammengeschusterte Variant alternative), hier ist ein kleines Beispielprogramm mit Variants:

Code: Alles auswählen

program Project1;
 
{$mode objfpc}{$H+}
 
uses
  variants, fgl;
 
type TVariantList = specialize TFPGList<Variant>;
 
var l: TVariantList;
  v: Variant;
begin
  l:=TVariantList.Create;
  try
    l.Add(12);
    l.Add(3.2);
    l.Add('Text');
    for v in l do
      WriteLn(v);
  finally
    l.Free;
  end;
end.    

[marcov]

Variant kann man nutzen, aber das Problem ist eher es so zu machen das ein IN, INCLUDE oder EXCLUDE aehnliche Operationen nicht alle Elementen durchsuchen müssen. (INCLUDE muss kontrollieren ob es Element nicht schon da ist).

Dafuer konnte man vielleicht irgend ein Hash<variant> nutzen. Im Hashvalue solten dann Variant.vartype und ein (Teil-)hash der Wert zurück kommen.

[Frank Ranis]

Hallo,

habe mal mit der Varianten-Klasse

Code: Alles auswählen

type TVariantSet = specialize TFPGList<Variant>; 
 

von Warf rumgespielt.

Einfügen , suchen klappt soweit (etwas Fummelei) .
Direktes suchen per TFPGList.IndexOf hat leider nicht richtig geklappt , da sind wohl noch Macken in den Freepascal-Sourcen drinn.

Code: Alles auswählen

// LAZ-Version 1.4.4 PFC 2.6.4
function TFPGList.IndexOf(const Item: T): Integer; 
begin
  Result := 0;
  {$info TODO: fix inlining to work! InternalItems[Result]^}    // <--- hier die Bemerkung !!!!!!!
  while (Result < FCount) and (PT(FList)[Result] <> Item) do
    Inc(Result);
  if Result = FCount then
    Result := -1;
end;  
 

Habe dann die Liste per Schleife durchsucht.

Auch das Löschen per TFPGList.Remove hat nicht geklappt , weil auch hier TFPGList.IndexOf benutzt wird.

Unten noch alle Quellen im Anhang.

Das Ganze läuft auch nur unter LAZ/FPC , leider nicht unter Delphi .

Gruß

Frank

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, variants, fgl;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
type TVariantSet = specialize TFPGList<Variant>;
 
var
  Form1: TForm1;
  TestSet:TVariantSet;
 
function wert_in_set(wert:variant;list:TVariantSet;var pos:integer):boolean;
procedure add_to_set(wert:variant;list:TVariantSet);
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
// Wert anfügen
procedure add_to_set(wert:variant;list:TVariantSet);
var pos:integer;
begin
 // Prüfen, ob Wert schon vorhanden ist ,
 // da er nur einmal im Set vorhanden sein soll
 if not wert_in_set(wert,list,pos)
  then
   list.Add(wert);
end;
 
// Wert finden
function wert_in_set(wert:variant;list:TVariantSet;var pos:integer):boolean;
var
 v: Variant;
 i:integer;
begin
 result:=false;
 pos:=-1;
 for v in list do
  begin
   // Float prüfen
   if (VarIsFloat(v)) and (VarIsFloat(wert)) and (v=wert)
    then
     begin
      result:=true;
      for i:=0 to list.Count-1 do
       begin
        if (VarIsFloat(list[i])) and  (list[i]=wert)
         then
          begin
           pos:=i;
           break;
          end;
       end;
      exit;
     end;
   // Integer prüfen
   if (VarIsNumeric(v)) and (VarIsNumeric(wert)) and (v=wert)
    then
     begin
      result:=true;
      for i:=0 to list.Count-1 do
       begin
        if (VarIsNumeric(list[i])) and  (list[i]=wert)
         then
          begin
           pos:=i;
           break;
          end;
       end;
      exit;
     end;
   // String
   if (VarIsStr(v)) and (VarIsStr(wert)) and (v=wert)
    then
     begin
      result:=true;
      for i:=0 to list.Count-1 do
       begin
        if (VarIsStr(list[i])) and  (list[i]=wert)
         then
          begin
           pos:=i;
           break;
          end;
       end;
      exit;
     end;
  end;
end;
 
// Werte an die Set-Liste anfügen
procedure TForm1.Button1Click(Sender: TObject);
begin
 add_to_set('Otto',TestSet);
 add_to_set(12,TestSet);
 add_to_set(2,TestSet);
 add_to_set(3.200000000,TestSet);
 add_to_set('Text',TestSet);
 add_to_set(1,TestSet);
 add_to_set(55.8800000000,TestSet);
 add_to_set('Hallo',TestSet);
 
 Button5.click;
end;
 
// Test Integer suchen
procedure TForm1.Button2Click(Sender: TObject);
var i,pos:integer;
begin
 i:=strtoint(edit1.text);
 if wert_in_set(i,TestSet,pos)
  then panel1.color:=cllime
  else panel1.color:=clred;
 
 panel1.Caption:=inttostr(pos);
end;
 
// Test Double suchen
procedure TForm1.Button3Click(Sender: TObject);
var d:double;
    pos:integer;
begin
 d:=strtofloat(edit2.text);
 if wert_in_set(d,TestSet,pos)
  then panel2.color:=cllime
  else panel2.color:=clred;
 
 panel2.Caption:=inttostr(pos);
end;
 
// Test String suchen
procedure TForm1.Button4Click(Sender: TObject);
var str:string;
    pos:integer;
begin
 str:=edit3.text;
 if wert_in_set(str,TestSet,pos)
  then panel3.color:=cllime
  else panel3.color:=clred;
 
 panel3.Caption:=inttostr(pos);
end;
 
// Test Set ausgeben
procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
    v:variant;
    s:string;
begin
 memo1.Clear;;
 for i:=0 to TestSet.count-1 do
  begin
   v:=TestSet[i];
   s:='';
   if VarIsStr(v) then s:=v;
   if varisnumeric(v) then s:=inttostr(v);
   if varisfloat(v) then s:=floattostr(v);
   memo1.Lines.Add(inttostr(i)+')  '+s);
  end;
end;
 
 initialization
 TestSet:=TVariantSet.Create;
 
 finalization
 TestSet.Free;
 
 
end.

[Michl]

Direktes suchen per TFPGList.IndexOf hat leider nicht richtig geklappt , da sind wohl noch Macken in den Freepascal-Sourcen drinn.

Das sollte es aber mMn. Scheinbar funktioniert eine variantspezialisierte Liste mit Strings aber nicht z.B. mit der Übergabe eines Integers:

Code: Alles auswählen

program Project1;
 
{$mode delphi}
 
uses fgl;
 
type
  TVariantList = class(specialize TFPGList<Variant>)
  end;
 
var
  aList: TVariantList;
 
begin
  aList := TVariantList.Create;
  aList.Add('Test');
  aList.Add('Hello');
  aList.Add('World');
  aList.Add(1.23);
  aList.Add(456);
 
  WriteLn(aList.IndexOf('World'));               // 2 -> OK
  WriteLn(aList.IndexOf('456'));                 // 4 -> OK
  WriteLn(aList.IndexOf(String(Variant(1.23)))); // 3 -> OK
  WriteLn(aList.IndexOf(String(Variant(456))));  // 4 -> OK
  WriteLn(aList.IndexOf(456));                   // Exception: Invalid variant type cast
 
  ReadLn;
  aList.Free;
end.

[Michl]

Man könnte die fgl.pp patchen und sowas machen:

Code: Alles auswählen

function TFPGList.IndexOf(const Item: T): Integer;
begin
  Result := 0;
  {$info TODO: fix inlining to work! InternalItems[Result]^}
  while Result < FCount do
  begin
    try
      if (PT(FList)[Result] = Item) then Break;
    except
      on e: Exception do;
//      on e: Exception do DebugLn(e.Message);
    end;
    Inc(Result);
  end;
  if Result = FCount then
    Result := -1;
end; 

Dann funktioniert auch dieser Code:

Code: Alles auswählen

program project1;
 
uses fgl;
 
type
  TVariantList = class(specialize TFPGList<Variant>)
  end;
 
var
  aList: TVariantList;
 
begin
  aList := TVariantList.Create;
  aList.Add('Test');
  aList.Add('Hello');
  aList.Add('World');
  aList.Add(1.23);
  aList.Add(456);
  aList.Add('2');
 
  WriteLn(aList.IndexOf('World')); // 2
  WriteLn(aList.IndexOf('456'));   // 4
  WriteLn(aList.IndexOf(456));     // 4
  WriteLn(aList.IndexOf(2));       // 5
  WriteLn(aList.IndexOf(1.23));    // 3
 
  aList.Free;
 
  ReadLn;
end.

Ob das klug ist, steht auf einem anderen Blatt...

[Frank Ranis]

Hallo ,

also die TFPGList.IndexOf Geschichte macht nur Probleme .
Mal funzt es nach Michl's Methode , mal ballert es .

Habe aber aus der Idee mit dem

Code: Alles auswählen

  WriteLn(aList.IndexOf(String(Variant(1.23))));
  WriteLn(aList.IndexOf(String(Variant(456))));
 

nun meine Wert-Finden-Funktion geändert .

Und auch einen Remove-Ersatz gebaut

procedure sub_from_set(wert:variant;list:TVariantSet);

Das klappt nun ganz gut .

Im Prinzip läuft das aber wieder auf eine Umwandlung auf Stringgeschichte hinaus , so wie ich es am Anfang mit meinem StringSet gemacht habe.
Weil ja die IndexOF-Methode Prob's macht.
Halt nur ohne den Delimiter als Trenner.

Bleibt noch das schnelle durchsuchen der Datensätze .

Und eine portabel Lösung für alle Pascal-Dialekte zu bauen, denn mit

Code: Alles auswählen

type TVariantSet = specialize TFPGList<Variant>;

ist man auf LAZ/FPC beschränkt.

Gruß

Frank

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, variants, fgl;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
type TVariantSet = specialize TFPGList<Variant>;
 
var
  Form1: TForm1;
  TestSet:TVariantSet;
 
function wert_in_set(wert:variant;list:TVariantSet;var pos:integer):boolean;
procedure add_to_set(wert:variant;list:TVariantSet);
procedure sub_from_set(wert:variant;list:TVariantSet);
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
// Wert auschneiden , Ersatz für TFPGList.Remove
procedure sub_from_set(wert:variant;list:TVariantSet);
var pos:integer;
begin
 if wert_in_set(wert,list,pos)
  then testset.Delete(pos);
end;
 
// Wert anfügen
procedure add_to_set(wert:variant;list:TVariantSet);
var pos:integer;
begin
 // Prüfen, ob Wert schon vorhanden ist ,
 // da er nur einmal im Set vorhanden sein soll
 if not wert_in_set(wert,list,pos)
  then
   list.Add(wert);
end;
 
// Wert finden , Ersatz für TFPGList.IndexOf
function wert_in_set(wert:variant;list:TVariantSet;var pos:integer):boolean;
var
 v: Variant;
 i:integer;
begin
 result:=false;
 pos:=-1;
 for i:=0 to list.Count-1 do
  begin
   v:=list[i];
   if string(variant(v)) = string(variant(wert))
    then
     begin
      pos:=i;
      result:=true;
      break;
     end;
   end;
end;
 
 
// Werte an die Set-Liste anfügen
procedure TForm1.Button1Click(Sender: TObject);
begin
 add_to_set('Otto',TestSet);
 add_to_set(12,TestSet);
 add_to_set(2,TestSet);
 add_to_set(3.200000000,TestSet);
 add_to_set('Text',TestSet);
 add_to_set(1,TestSet);
 add_to_set(55.8800000000,TestSet);
 add_to_set('Hallo',TestSet);
 
 Button5.click;
end;
 
// Test Integer suchen
procedure TForm1.Button2Click(Sender: TObject);
var i,pos:integer;
begin
 i:=strtoint(edit1.text);
 if wert_in_set(i,TestSet,pos)
  then panel1.color:=cllime
  else panel1.color:=clred;
 
 panel1.Caption:=inttostr(pos);
end;
 
// Test Double suchen
procedure TForm1.Button3Click(Sender: TObject);
var d:double;
    pos:integer;
begin
 d:=strtofloat(edit2.text);
 if wert_in_set(d,TestSet,pos)
  then panel2.color:=cllime
  else panel2.color:=clred;
 
 panel2.Caption:=inttostr(pos);
end;
 
// Test String suchen
procedure TForm1.Button4Click(Sender: TObject);
var str:string;
    pos:integer;
begin
 str:=edit3.text;
 if wert_in_set(str,TestSet,pos)
  then panel3.color:=cllime
  else panel3.color:=clred;
 
 panel3.Caption:=inttostr(pos);
end;
 
// Test Set ausgeben
procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
    v:variant;
    s:string;
begin
 memo1.Clear;;
 for i:=0 to TestSet.count-1 do
  begin
   v:=TestSet[i];
   s:='';
   if VarIsStr(v) then s:=v;
   if varisnumeric(v) then s:=inttostr(v);
   if varisfloat(v) then s:=floattostr(v);
   memo1.Lines.Add(inttostr(i)+')  '+s);
  end;
end;
 
// Test Wert löschen
procedure TForm1.Button6Click(Sender: TObject);
var str:string;
begin
 str:=edit4.text;
 sub_from_set(str,testset);
 
 button5.Click;
end;
 
 initialization
 TestSet:=TVariantSet.Create;
 
 finalization
 TestSet.Free;
 
 
end.
 

[Frank Ranis]

Hallo ,

nun noch die Varianten_Set_Version Nr3.

Anstelle von TFPGList<Variant> nehme ich nun einfach ein TStringlist .

Und schon hat man keinerlei Prob's mehr mit Suchen , löschen etc.

Die Werte_finden-Routine ist jetzt auf ein Minimum geschrumpft .

Und das Beste , es sollte nun unter allen Pascal-Systemen laufen .

Gruß

Frank

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, variants;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
 
var
  Form1: TForm1;
  TestSet:TStringlist;
 
function wert_in_set(wert:variant;list:TStringlist;var pos:integer):boolean;
procedure add_to_set(wert:variant;list:TStringlist);
procedure sub_from_set(wert:variant;list:TStringlist);
 
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
// Wert auschneiden
procedure sub_from_set(wert:variant;list:TStringlist);
var pos:integer;
begin
 if wert_in_set(wert,list,pos)
  then testset.Delete(pos);
end;
 
// Wert anfügen
procedure add_to_set(wert:variant;list:TStringlist);
var pos:integer;
begin
 // Prüfen, ob Wert schon vorhanden ist ,
 // da er nur einmal im Set vorhanden sein soll
 if not wert_in_set(wert,list,pos)
  then
   list.Add(wert);
end;
 
// Wert finden
function wert_in_set(wert:variant;list:TStringlist;var pos:integer):boolean;
var
 v: Variant;
 i:integer;
begin
 result:=false;
 pos:=list.IndexOf(string(variant(wert)));
 if pos>-1
  then result:=true;
end;
 
 
// Werte an die Set-Liste anfügen
procedure TForm1.Button1Click(Sender: TObject);
begin
 add_to_set('Otto',TestSet);
 add_to_set(12,TestSet);
 add_to_set(2,TestSet);
 add_to_set(3.200000000,TestSet);
 add_to_set('Text',TestSet);
 add_to_set(1,TestSet);
 add_to_set(55.8800000000,TestSet);
 add_to_set('Hallo',TestSet);
 
 Button5.click;
end;
 
// Test Integer suchen
procedure TForm1.Button2Click(Sender: TObject);
var i,pos:integer;
begin
 i:=strtoint(edit1.text);
 if wert_in_set(i,TestSet,pos)
  then panel1.color:=cllime
  else panel1.color:=clred;
 
 panel1.Caption:=inttostr(pos);
end;
 
// Test Double suchen
procedure TForm1.Button3Click(Sender: TObject);
var d:double;
    pos:integer;
begin
 d:=strtofloat(edit2.text);
 if wert_in_set(d,TestSet,pos)
  then panel2.color:=cllime
  else panel2.color:=clred;
 
 panel2.Caption:=inttostr(pos);
end;
 
// Test String suchen
procedure TForm1.Button4Click(Sender: TObject);
var str:string;
    pos:integer;
begin
 str:=edit3.text;
 if wert_in_set(str,TestSet,pos)
  then panel3.color:=cllime
  else panel3.color:=clred;
 
 panel3.Caption:=inttostr(pos);
end;
 
// Test Set ausgeben
procedure TForm1.Button5Click(Sender: TObject);
var i:integer;
    v:variant;
    s:string;
begin
 memo1.Clear;;
 for i:=0 to TestSet.count-1 do
  begin
   v:=TestSet[i];
   s:='';
   if VarIsStr(v) then s:=v;
   if varisnumeric(v) then s:=inttostr(v);
   if varisfloat(v) then s:=floattostr(v);
   memo1.Lines.Add(inttostr(i)+')  '+s);
  end;
end;
 
// Test Wert löschen
procedure TForm1.Button6Click(Sender: TObject);
var str:string;
begin
 str:=edit4.text;
 sub_from_set(str,testset);
 
 button5.Click;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 
end;
 
 initialization
 TestSet:=TStringlist.Create;
 
 finalization
 TestSet.Free;
 
 
end.
 
 

[marcov]

Viele generische Typen haben ein Prozedurvariabelen für das vergleichen der Werte. Ich nutze meistens Delphi generics.collections, und ein eigen generischer Map. (originell entwickelt weil TStringList Performanceprobleme hat mit >100000 geordnete Zeilen)

Dies ist auch ein Beispiel wie man so etwas mach ohne nach String um zu wandeln. (keine "stringly Typing")

Lauft auch auf Delphi (XE2 oder XE3+. In frühere Versionen sind generics Defekt)

[Frank Ranis]

Hallo ,

Danke marcov.

Ich denke mal , jetzt kann sich jeder was passendes zusammenstellen .

Gruß

Frank

Viele generische Typen haben ein Prozedurvariabelen für das vergleichen der Werte. Ich nutze meistens Delphi generics.collections, und ein eigen generischer Map. (originell entwickelt weil TStringList Performanceprobleme hat mit >100000 geordnete Zeilen)

Dies ist auch ein Beispiel wie man so etwas mach ohne nach String um zu wandeln. (keine "stringly Typing")

Lauft auch auf Delphi (XE2 oder XE3+. In frühere Versionen sind generics Defekt)