initialer CommitHEADmaster

1 files changed, 2050 insertions, 0 deletions

diff --git a/grampstypen.pas b/grampstypen.pas
new file mode 100644
index 0000000..4505324
--- /dev/null
+++ b/grampstypen.pas
@@ -0,0 +1,2050 @@
+unit grampstypen;
+
+interface
+
+uses classes, matheunit;
+
+type
+ tExtendedArray = array of extended;
+ tIntArray = array of longint;
+ tIntArrayArray = array of tIntArray;
+ tBooleanArray = array of boolean;
+ tPointArray = array of tPoint;
+ tPointArrayArray = array of tPointArray;
+ tEreignisart = (eaDummy,eaGeburt,eaTod,eaHochzeit,eaTaufe,eaBeerdigung,eaSonstiges);
+ t4DPoint = record
+   x,y,z,u: longint;
+ end;
+ tExtPoint = record
+   x,y: extended;
+ end;
+ tSchrittErgebnis = record
+   besserAlsVorher,
+     faktorNeutralisiert: boolean;
+   Platzveraenderung:     longint;
+ end;
+ t4DPointArray = array of t4DPoint;
+ tParameterAttribut = object
+   istKoordinate,istUnabhaengig,wirdBenutzt: boolean;
+   procedure setzeKoordinate(ik: boolean);
+   procedure setzeUnabhaengig(iu: boolean);
+   procedure setzeBenutzt(wb: boolean);
+   procedure fromChar(c: char);
+   function toChar: char;
+ end;
+ tParameterAttributArray = array of tParameterAttribut;
+ tGenerikum = class
+   ID:    string;
+   index: longint;
+   constructor create;
+   destructor destroy; override;
+   procedure init(g: tGenerikum); dynamic;
+   function istGleich(g: tGenerikum): boolean; dynamic;
+ end;
+ tGenerikumArray = array of tGenerikum;
+ tEreignis = class;
+ tEreignisArray = array of tEreignis;
+ tPerson = class;
+ tPersonArray = array of tPerson;
+ tFamilie = class;
+ tFamilieArray = array of tFamilie;
+ tVerknuepfung = class;
+ tVerknuepfungArray = array of tVerknuepfung;
+ tMMInteraktion = class;
+ tMMInteraktionArray = array of tMMInteraktion;
+ tMFInteraktion = class;
+ tMFInteraktionArray = array of tMFInteraktion;
+ tFFInteraktion = class;
+ tFFInteraktionArray = array of tFFInteraktion;
+
+ tEreignis = class (tGenerikum)
+   Jahr: longint;
+   Art: tEreignisart;
+   function istDummy: boolean;
+   constructor create;
+   destructor destroy; override;
+   procedure init(e: tGenerikum); override;
+   function istGleich(e: tGenerikum): boolean; override;
+ end;
+ tPerson = class (tGenerikum)
+   Anfang,Ende: tEreignis;
+   Ereignisse: array[tEreignisart] of tEreignis;
+   KindIn: tFamilie;
+   ElterIn: tFamilieArray;
+   inputIn,outputIn: tVerknuepfungArray;
+   inMMInteraktion: tMMInteraktionArray;
+   inMFInteraktion: tMFInteraktionArray;
+   Vorname,Nachname: string;
+   p1,p2,p3: longint;
+   constructor create;
+   destructor destroy; override;
+   procedure entferneElterIn(wo: tFamilie);
+   procedure entferneKindIn(wo: tFamilie);
+   procedure fuegeInputInHinzu(wo: tVerknuepfung);
+   procedure entferneInputIn(wo: tVerknuepfung);
+   procedure fuegeOutputInHinzu(wo: tVerknuepfung);
+   procedure entferneOutputIn(wo: tVerknuepfung);
+   procedure fuegeInMMInteraktionHinzu(wo: tMMInteraktion);
+   procedure entferneInMMInteraktion(wo: tMMInteraktion);
+   procedure fuegeInMFInteraktionHinzu(wo: tMFInteraktion);
+   procedure entferneInMFInteraktion(wo: tMFInteraktion);
+   procedure init(p: tGenerikum); override; overload;
+   procedure init(p: tGenerikum; var es: tEreignisArray); overload;
+   procedure init(p: tGenerikum; var es: tEreignisArray; var fs: tFamilieArray); overload;
+   procedure init(p: tGenerikum; var es: tEreignisArray; var fs: tFamilieArray; darfErzeugen: boolean); overload;
+   function anzahlVerbindungen: longint;
+   function istGleich(p: tGenerikum): boolean; override;
+   function elterVonFamilie(eNum: longint): tFamilie;
+   function istElterIn(f: tFamilie): boolean;
+ end;
+ tFamilie = class (tGenerikum)
+   Anfang: tEreignis;
+   verheiratet: boolean;
+   Eltern: array[0..1] of tPerson;
+   Kinder: tPersonArray;
+   inMFInteraktion: tMFInteraktionArray;
+   inFFInteraktion: tFFInteraktionArray;
+   constructor create;
+   destructor destroy; override;
+   procedure entferneElter(wen: tPerson);
+   procedure entferneKind(wen: tPerson);
+   procedure fuegeInMFInteraktionHinzu(wo: tMFInteraktion);
+   procedure entferneInMFInteraktion(wo: tMFInteraktion);
+   procedure fuegeInFFInteraktionHinzu(wo: tFFInteraktion);
+   procedure entferneInFFInteraktion(wo: tFFInteraktion);
+   procedure init(f: tGenerikum); override; overload;
+   procedure init(f: tGenerikum; var Es: tEreignisArray; var Ps: tPersonArray); overload;
+   procedure init(f: tGenerikum; var Es: tEreignisArray; var Ps: tPersonArray; darfErzeugen: boolean); overload;
+   function anzahlVerbindungen: longint; inline;
+   function istGleich(f: tGenerikum): boolean; override;
+   function hatKind(p: tPerson): boolean; inline;
+   function hatElter(p: tPerson): boolean; inline;
+ end;
+ tVerknuepfung = class
+ private
+   _outP: tPerson;
+   procedure wOutP(p: tPerson);
+ public
+   index:  longint;
+   Input:  array[0..1,'x'..'y'] of Longint;
+   Lambda: Longint;
+   Output: array['x'..'y'] of Longint;
+   property outP: tPerson
+     read _outP
+     write wOutP;
+   destructor destroy; override;
+   function istGleich(v: tVerknuepfung; p2p: tIntArray): boolean;
+ end;
+ tMMInteraktion = class
+ private
+   __Ps: array[0..1] of tPerson;
+   function r_Ps(i: longint): tPerson; inline;
+   procedure w_Ps(i: longint; p: tPerson);
+ public
+   index: longint;
+   Laenge: extended;
+   property _Ps[i: integer]: tPerson
+     read r_Ps
+     write w_Ps;
+   destructor destroy; override;
+   function istGleich(ia: tMMInteraktion): boolean;
+ end;
+ tMFInteraktion = class
+ private
+   __P: tPerson;
+   __F: tFamilie;
+   procedure w_P(p: tPerson);
+   procedure w_F(f: tFamilie);
+ public
+   index: longint;
+   Laenge: extended;
+   property _P: tPerson
+     read __P
+     write w_P;
+   property _F: tFamilie
+     read __F
+     write w_F;
+   destructor destroy; override;
+   function istGleich(ia: tMFInteraktion): boolean;
+ end;
+ tFFInteraktion = class
+ private
+   __Fs: array[0..1] of tFamilie;
+   function r_Fs(i: longint): tFamilie; inline;
+   procedure w_Fs(i: longint; f: tFamilie);
+ public
+   index: longint;
+   property _Fs[i: integer]: tFamilie
+     read r_Fs
+     write w_Fs;
+   destructor destroy; override;
+   function istGleich(ia: tFFInteraktion): boolean;
+ end;
+
+ tZusammenhangskomponente = class
+ public
+   Familien: tFamilieArray;
+   constructor create;
+   destructor destroy; override;
+   function grenztAn(p: tPerson): boolean;
+   procedure verschmelzeMit(zhk: tZusammenhangskomponente);
+   procedure UmfeldEinfuegen(Fs: tFamilieArray; p: tPerson);
+ end;
+
+ tGraph = class
+ private
+   function entferneBlaetter(var f: tIntArray): tIntArray;
+   function Pfadigkeit(Ks: tIntArray; a,b: longint): longint; // 0 -> zu wenig; 1 -> ein Pfad; 2-> zu viel
+   function etwasDoppelt: boolean; overload;
+   function etwasDoppelt(Ks: tIntArray): boolean; overload;
+   function etwasRedundant(Ks1,Ks2: tIntArray): boolean;
+   procedure dumpKantenArray(Ks: tIntArray);
+ public
+   Ecken,Kanten:    tPointArray;
+   constructor create;
+   destructor destroy; override;
+   function findeKreise: tIntArrayArray;
+   function findeKreise(f: tIntArray): tIntArrayArray;
+ end;
+
+ tSortObject = class
+   oG:  tGenerikum;
+   oMM: tMMInteraktion;
+   oMF: tMFInteraktion;
+   oFF: tFFInteraktion;
+   oV:  tVerknuepfung;
+   ID:  string;
+   constructor create;
+   procedure assign(g: tGenerikum); overload;
+   procedure assign(i: tMMInteraktion); overload;
+   procedure assign(i: tMFInteraktion); overload;
+   procedure assign(i: tFFInteraktion); overload;
+   procedure assign(v: tVerknuepfung); overload;
+ end;
+ tSortObjectArray = array of tSortObject;
+
+function paramsGleich(p1,p2: longint; p2p: tIntArray): boolean; inline;
+function pEreignisToStr(E: tEreignis): string; inline;
+function pFamilieToStr(F: tFamilie): string; inline;
+function pPersonToStr(P: tPerson): string; inline;
+function tEreignisToStr(E: tEreignis): string; inline;
+function tPersonToStr(P: tPerson): string; inline;
+function tFamilieToStr(F: tFamilie): string; inline;
+function tVerknuepfungToStr(V: tVerknuepfung): string; inline;
+function tMMInteraktionToStr(I: tMMInteraktion): string; inline;
+function tMFInteraktionToStr(I: tMFInteraktion): string; inline;
+function tFFInteraktionToStr(I: tFFInteraktion): string; inline;
+function findeEreignis(var Es: tEreignisArray; eID: string): tEreignis;
+function findeFamilie(var Fs: tFamilieArray; fID: string): tFamilie; overload;
+function findeFamilie(var Fs: tFamilieArray; fID: string; darfErzeugen: boolean): tFamilie; overload;
+function findePerson(var Ps: tPersonArray; pID: string): tPerson; overload;
+function findePerson(var Ps: tPersonArray; pID: string; darfErzeugen: boolean): tPerson; overload;
+function findeMMInteraktion(var MMs: tMMInteraktionArray; var Ps: tPersonArray; ia: string): tMMInteraktion;
+function findeMFInteraktion(var MFs: tMFInteraktionArray; var Ps: tPersonArray; var Fs: tFamilieArray; ia: string): tMFInteraktion;
+function findeFFInteraktion(var FFs: tFFInteraktionArray; var Fs: tFamilieArray; ia: string): tFFInteraktion;
+procedure loescheEreignis(var Es: tEreignisArray; eID: string);
+procedure loescheFamilie(var Fs: tFamilieArray; fID: string);
+procedure loeschePerson(var Ps: tPersonArray; pID: string);
+procedure mergePerson(var Ps: tPersonArray; var P: tPerson);
+procedure mergeFamilie(var Fs: tFamilieArray; var F: tFamilie);
+function importEreignis(s: string; var Es: tEreignisArray): tEreignis;
+function importPerson(s: string; var Ps: tPersonArray; var Es: tEreignisArray; var Fs: tFamilieArray): tPerson;
+function importFamilie(s: string; var Ps: tPersonArray; var Es: tEreignisArray; var Fs: tFamilieArray): tFamilie;
+function strToTVerknuepfung(var Ps: tPersonArray; s: string): tVerknuepfung;
+function importMMInteraktion(var Ps: tPersonArray; s: string): tMMInteraktion;
+function importMFInteraktion(var Ps: tPersonArray; var Fs: tFamilieArray; s: string): tMFInteraktion;
+function importFFInteraktion(var Fs: tFamilieArray; s: string): tFFInteraktion;
+function importFamilieArray(var s: string; var Fs: tFamilieArray): tFamilieArray;
+function importPersonArray(var s: string; var Ps: tPersonArray): tPersonArray;
+procedure strToTIntArray(var s: string; var A: tIntArray);
+function Permutation(n: longint): tIntArray;
+function sortStringFromObject(g: tGenerikum): string; overload;
+function sortStringFromObject(i: tMMInteraktion): string; overload;
+function sortStringFromObject(i: tMFInteraktion): string; overload;
+function sortStringFromObject(i: tFFInteraktion): string; overload;
+function sortStringFromObject(v: tVerknuepfung): string; overload;
+function sortiere(arr: tGenerikumArray): tGenerikumArray; overload; inline;
+function sortiere(arr: tMMInteraktionArray): tMMInteraktionArray; overload; inline;
+function sortiere(arr: tMFInteraktionArray): tMFInteraktionArray; overload; inline;
+function sortiere(arr: tFFInteraktionArray): tFFInteraktionArray; overload; inline;
+function sortiere(arr: tVerknuepfungArray): tVerknuepfungArray; overload; inline;
+function sortiere(arr: tSortObjectArray): tSortObjectArray; overload; inline;
+procedure sortiere(var arr: tSortObjectArray; von,bis: longint; mi,ma: string); overload;
+
+implementation
+
+uses sysutils;
+
+function paramsGleich(p1,p2: longint; p2p: tIntArray): boolean;
+begin
+ if p2=-1 then result:=p1=-1
+ else result:=p2p[p2]=p1;
+end;
+
+function pEreignisToStr(E: tEreignis): string;
+begin
+  if assigned(E) then
+    result:=E.ID
+  else
+    result:='NIL';
+end;
+
+function pFamilieToStr(F: tFamilie): string;
+begin
+  if assigned(F) then
+    result:=F.ID
+  else
+    result:='NIL';
+end;
+
+function pPersonToStr(P: tPerson): string;
+begin
+  if assigned(P) then
+    result:=P.ID
+  else
+    result:='NIL';
+end;
+
+function TEreignisToStr(E: TEreignis): String;
+begin
+ TEreignisToStr:=
+   E.ID+' '+
+   inttostr(E.Jahr)+' '+
+   inttostr(Integer(E.Art));
+end;
+
+function TPersonToStr(P: TPerson): String;
+var
+ ea: TEreignisart;
+ I: Longint;
+begin
+ result:=
+   P.ID+' '+
+   pEreignisToStr(P.Anfang)+' '+
+   pEreignisToStr(P.Ende)+' ';
+ for ea:=low(TEreignisart) to high(TEreignisart) do
+   result:=result+PEreignisToStr(P.Ereignisse[ea])+' ';
+ result:=result+
+   pFamilieToStr(P.KindIn)+' '+
+   inttostr(length(P.ElterIn))+' ';
+ for I:=0 to length(P.ElterIn)-1 do
+   result:=result+
+     pFamilieToStr(P.ElterIn[I])+' ';
+ result:=result+
+   ''''+P.Vorname+''' '+
+   ''''+P.Nachname+''' '+
+   inttostr(P.P1)+' '+
+   inttostr(P.P2)+' '+
+   inttostr(P.P3);
+end;
+
+function TFamilieToStr(F: TFamilie): String;
+var
+ I: Longint;
+begin
+ result:=
+   F.ID+' '+
+   PEreignisToStr(F.Anfang)+' '+
+   inttostr(byte(F.Verheiratet))+' '+
+   pPersonToStr(F.Eltern[0])+' '+
+   pPersonToStr(F.Eltern[1])+' '+
+   inttostr(length(F.Kinder));
+ for I:=0 to length(F.Kinder)-1 do
+   result:=result+' '+
+     pPersonToStr(F.Kinder[I]);
+end;
+
+function TVerknuepfungToStr(V: TVerknuepfung): String;
+begin
+ result:=
+   pPersonToStr(V.outP)+' '+
+   inttostr(V.Input[0,'x'])+' '+
+   inttostr(V.Input[0,'y'])+' '+
+   inttostr(V.Input[1,'x'])+' '+
+   inttostr(V.Input[1,'y'])+' '+
+   inttostr(V.Lambda)+' '+
+   inttostr(V.Output['x'])+' '+
+   inttostr(V.Output['y']);
+end;
+
+function TMMInteraktionToStr(I: TMMInteraktion): String;
+begin
+ result:=
+   pPersonToStr(I._Ps[0])+' '+
+   pPersonToStr(I._Ps[1])+' '+
+   myfloattostr(I.Laenge);
+end;
+
+function TMFInteraktionToStr(I: TMFInteraktion): String;
+begin
+ TMFInteraktionToStr:=
+   pPersonToStr(I._P)+' '+
+   pFamilieToStr(I._F)+' '+
+   myfloattostr(I.Laenge);
+end;
+
+function TFFInteraktionToStr(I: TFFInteraktion): String;
+begin
+ TFFInteraktionToStr:=
+   pFamilieToStr(I._Fs[0])+' '+
+   pFamilieToStr(I._Fs[1]);
+end;
+
+function findeEreignis(var Es: tEreignisArray; eID: String): tEreignis;
+var i: longint;
+begin
+ if eID='NIL' then begin
+   result:=nil;
+   exit;
+ end;
+ for i:=0 to length(Es)-1 do
+   if Es[i].ID=eID then begin
+     result:=Es[i];
+     exit;
+   end;
+ result:=tEreignis.create;
+ result.ID:=eID;
+ setlength(Es,length(Es)+1);
+ Es[length(Es)-1]:=result;
+ Es[length(Es)-1].index:=length(Es)-1;
+end;
+
+function findeFamilie(var Fs: tFamilieArray; fID: String): tFamilie;
+begin
+ result:=findeFamilie(Fs,fID,true);
+end;
+
+function findeFamilie(var Fs: tFamilieArray; fID: String; darfErzeugen: boolean): tFamilie;
+var i: longint;
+begin
+ if fID='NIL' then begin
+   result:=nil;
+   exit;
+ end;
+ for i:=0 to length(Fs)-1 do
+   if Fs[i].ID=fID then begin
+     result:=Fs[i];
+     exit;
+   end;
+ if darfErzeugen then begin
+   result:=tFamilie.create;
+   result.ID:=fID;
+   setlength(Fs,length(Fs)+1);
+   Fs[length(Fs)-1]:=result;
+   Fs[length(Fs)-1].index:=length(Fs)-1;
+ end
+ else
+   result:=nil;
+end;
+
+function findePerson(var Ps: tPersonArray; pID: String): tPerson;
+begin
+ result:=findePerson(Ps,pID,true);
+end;
+
+function findePerson(var Ps: tPersonArray; pID: String; darfErzeugen: boolean): tPerson;
+var i:  longint;
+begin
+ if pID='NIL' then begin
+   result:=nil;
+   exit;
+ end;
+ for i:=0 to length(Ps)-1 do
+   if Ps[i].ID=pID then begin
+     result:=Ps[i];
+     exit;
+   end;
+ if darfErzeugen then begin
+   result:=tPerson.create;
+   result.ID:=pID;
+   setlength(Ps,length(Ps)+1);
+   Ps[length(Ps)-1]:=result;
+   Ps[length(Ps)-1].index:=length(Ps)-1;
+ end
+ else
+   result:=nil;
+end;
+
+function findeMMInteraktion(var MMs: tMMInteraktionArray; var Ps: tPersonArray; ia: string): tMMInteraktion;
+var
+  i: longint;
+begin
+ for i:=0 to length(MMs)-1 do
+   if tMMInteraktionToStr(MMs[i])=ia then begin
+     result:=MMs[i];
+     exit;
+   end;
+ setlength(MMs,length(MMs)+1);
+ MMs[length(MMs)-1]:=importMMInteraktion(Ps,ia);
+ MMs[length(MMs)-1].index:=length(MMs)-1;
+end;
+
+function findeMFInteraktion(var MFs: tMFInteraktionArray; var Ps: tPersonArray; var Fs: tFamilieArray; ia: string): tMFInteraktion;
+var
+  i: longint;
+begin
+ for i:=0 to length(MFs)-1 do
+   if tMFInteraktionToStr(MFs[i])=ia then begin
+     result:=MFs[i];
+     exit;
+   end;
+ setlength(MFs,length(MFs)+1);
+ MFs[length(MFs)-1]:=importMFInteraktion(Ps,Fs,ia);
+ MFs[length(MFs)-1].index:=length(MFs)-1;
+end;
+
+function findeFFInteraktion(var FFs: tFFInteraktionArray; var Fs: tFamilieArray; ia: string): tFFInteraktion;
+var
+  i: longint;
+begin
+ for i:=0 to length(FFs)-1 do
+   if tFFInteraktionToStr(FFs[i])=ia then begin
+     result:=FFs[i];
+     exit;
+   end;
+ setlength(FFs,length(FFs)+1);
+ FFs[length(FFs)-1]:=importFFInteraktion(Fs,ia);
+ FFs[length(FFs)-1].index:=length(FFs)-1;
+end;
+
+procedure loescheEreignis(var Es: tEreignisArray; eID: string);
+var i,j: longint;
+begin
+ if eID='NIL' then
+   exit;
+ for i:=0 to length(Es)-1 do
+   if Es[i].ID=eID then begin
+     Es[i].free;
+     for j:=i+1 to length(Es)-1 do begin
+       Es[j-1]:=Es[j];
+       Es[j-1].index:=j-1;
+     end;
+     setlength(Es,length(Es)-1);
+     exit;
+   end;
+end;
+
+procedure loescheFamilie(var Fs: tFamilieArray; fID: string);
+var i,j: longint;
+begin
+ if fID='NIL' then
+   exit;
+ for i:=0 to length(Fs)-1 do
+   if Fs[i].ID=fID then begin
+     Fs[i].free;
+     for j:=i+1 to length(Fs)-1 do begin
+       Fs[j-1]:=Fs[j];
+       Fs[j-1].index:=j-1;
+     end;
+     setlength(Fs,length(Fs)-1);
+     exit;
+   end;
+end;
+
+procedure loeschePerson(var Ps: tPersonArray; pID: string);
+var i,j: longint;
+begin
+ if pID='NIL' then
+   exit;
+ for i:=0 to length(Ps)-1 do
+   if Ps[i].ID=pID then begin
+     Ps[i].free;
+     for j:=i+1 to length(Ps)-1 do begin
+       Ps[j-1]:=Ps[j];
+       Ps[j-1].index:=j-1;
+     end;
+     setlength(Ps,length(Ps)-1);
+     exit;
+   end;
+end;
+
+procedure mergePerson(var Ps: tPersonArray; var P: tPerson);
+var i:  longint;
+begin
+ for i:=0 to length(Ps)-1 do
+   if Ps[i].ID=P.ID then begin
+     P.free;
+     P:=Ps[i];
+     exit;
+   end;
+ setlength(Ps,length(Ps)+1);
+ Ps[length(Ps)-1]:=P;
+ Ps[length(Ps)-1].index:=length(Ps)-1;
+end;
+
+procedure mergeFamilie(var Fs: tFamilieArray; var F: tFamilie);
+var i: longint;
+begin
+ for i:=0 to length(Fs)-1 do
+   if Fs[i].ID=F.ID then begin
+     F.free;
+     F:=Fs[i];
+     exit;
+   end;
+ setlength(Fs,length(Fs)+1);
+ Fs[length(Fs)-1]:=F;
+ Fs[length(Fs)-1].index:=length(Fs)-1;
+end;
+
+function ImportEreignis(S: string; var Es: tEreignisArray): tEreignis;
+var i:     Longint;
+    found: boolean;
+begin
+ result:=tEreignis.create;
+ result.ID:=leftStr(S,pos(' ',S)-1);
+ found:=false;
+ for i:=0 to length(Es)-1 do
+   if result.ID = Es[i].ID then begin
+     result.free;
+     result:=Es[i];
+     found:=true;
+     break;
+   end;
+ if not found then begin
+   setlength(Es,length(Es)+1);
+   Es[length(Es)-1]:=result;
+   Es[length(Es)-1].index:=length(Es)-1;
+ end;
+ delete(S,1,pos(' ',S));
+ result.Jahr:=strtoint(leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.Art:=TEreignisart(strtoint(S));
+end;
+
+function ImportPerson(S: string; var Ps: tPersonArray; var Es: tEreignisArray; var Fs: tFamilieArray): tPerson;
+var i:     longint;
+    found: boolean;
+    ea:    TEreignisart;
+begin
+ result:=tPerson.create;
+ result.ID:=leftStr(S,pos(' ',S)-1);
+ found:=false;
+ for i:=0 to length(Ps)-1 do
+   if Ps[i].ID = result.ID then begin
+     result.free;
+     result:=Ps[i];
+     found:=true;
+     break;
+   end;
+ if not found then begin
+   setlength(Ps,length(Ps)+1);
+   Ps[length(Ps)-1]:=result;
+   Ps[length(Ps)-1].index:=length(Ps)-1;
+ end;
+ delete(S,1,pos(' ',S));
+ result.Anfang:=findeEreignis(Es,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.Ende:=findeEreignis(Es,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ for ea:=low(TEreignisart) to high(TEreignisart) do begin
+   result.Ereignisse[ea]:=findeEreignis(Es,leftStr(S,pos(' ',S)-1));
+   delete(S,1,pos(' ',S));
+ end;
+ result.KindIn:=findeFamilie(Fs,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.ElterIn:=ImportFamilieArray(S,Fs);
+ delete(S,1,1);
+ result.Vorname:=leftStr(S,pos('''',S)-1);
+ delete(S,1,pos('''',S)+2);
+ result.Nachname:=leftStr(S,pos('''',S)-1);
+ delete(S,1,pos('''',S)+1);
+ result.P1:=strtoint(leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.P2:=strtoint(leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.P3:=strtoint(S);
+end;
+
+function ImportFamilie(s: string; var Ps: tPersonArray; var Es: tEreignisArray; var Fs: tFamilieArray): tFamilie;
+var i:     longint;
+    found: boolean;
+begin
+ result:=tFamilie.create;
+ result.ID:=leftStr(S,pos(' ',S)-1);
+ found:=false;
+ for i:=0 to length(Fs)-1 do
+   if Fs[i].ID = result.ID then begin
+     result.free;
+     result:=Fs[i];
+     found:=true;
+     break;
+   end;
+ if not found then begin
+   setlength(Fs,length(Fs)+1);
+   Fs[length(Fs)-1]:=result;
+   Fs[length(Fs)-1].index:=length(Fs)-1;
+ end;
+ delete(S,1,pos(' ',S));
+ result.Anfang:=findeEreignis(Es,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.Verheiratet:=leftStr(S,pos(' ',S)-1)='1';
+ delete(S,1,pos(' ',S));
+ result.Eltern[0]:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.Eltern[1]:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ S:=S+' ';
+ result.Kinder:=importPersonArray(S,Ps);
+end;
+
+function strToTVerknuepfung(var Ps: tPersonArray; S: String): tVerknuepfung;
+var i: Longint;
+    c: Char;
+begin
+ S:=S+' ';
+ result:=tVerknuepfung.create;
+ result.outP:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ for i:=0 to 1 do
+   for c:='x' to 'y' do begin
+     result.Input[i,c]:=strtoint(leftStr(S,pos(' ',S)-1));
+     delete(S,1,pos(' ',S));
+   end;
+ result.Lambda:=strtoint(leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ for C:='x' to 'y' do begin
+   result.Output[C]:=strtoint(leftStr(S,pos(' ',S)-1));
+   delete(S,1,pos(' ',S));
+ end;
+end;
+
+function importMMInteraktion(var Ps: tPersonArray; S: String): tMMInteraktion;
+var i: Longint;
+begin
+ result:=tMMInteraktion.create;
+ for i:=0 to 1 do begin
+   result._Ps[i]:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+   delete(S,1,pos(' ',S));
+ end;
+ result.Laenge:=mystrtofloat(S);
+end;
+
+function importMFInteraktion(var Ps: tPersonArray; var Fs: tFamilieArray; S: String): tMFInteraktion;
+begin
+ result:=tMFInteraktion.create;
+ result._P:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result._F:=findeFamilie(Fs,leftStr(S,pos(' ',S)-1));
+ delete(S,1,pos(' ',S));
+ result.Laenge:=mystrtofloat(S);
+end;
+
+function importFFInteraktion(var Fs: tFamilieArray; S: String): tFFInteraktion;
+var i: longint;
+begin
+ result:=tFFInteraktion.create;
+ S:=S+' ';
+ for i:=0 to 1 do begin
+   result._Fs[i]:=findeFamilie(Fs,leftStr(S,pos(' ',S)-1));
+   delete(S,1,pos(' ',S));
+ end;
+end;
+
+function ImportFamilieArray(var S: String; var Fs: tFamilieArray): tFamilieArray;
+var I: Longint;
+begin
+ setlength(result,strtoint(leftStr(S,pos(' ',S)-1)));
+ delete(S,1,pos(' ',S));
+ for I:=0 to length(result)-1 do begin
+   result[I]:=findeFamilie(Fs,leftStr(S,pos(' ',S)-1));
+   result[I].index:=I;
+   delete(S,1,pos(' ',S));
+ end;
+end;
+
+function ImportPersonArray(var S: String; var Ps: tPersonArray): tPersonArray;
+var I: Longint;
+begin
+ setlength(result,strtoint(leftStr(S,pos(' ',S)-1)));
+ delete(S,1,pos(' ',S));
+ for I:=0 to length(result)-1 do begin
+   result[I]:=findePerson(Ps,leftStr(S,pos(' ',S)-1));
+   result[I].index:=I;
+   delete(S,1,pos(' ',S));
+ end;
+end;
+
+procedure StrToTIntArray(var S: String; var A: TIntArray);
+var I: Longint;
+begin
+ setlength(A,strtoint(leftStr(S,pos(' ',S)-1)));
+ delete(S,1,pos(' ',S));
+ for I:=0 to length(A)-1 do begin
+   A[I]:=strtoint(leftStr(S,pos(' ',S)-1));
+   delete(S,1,pos(' ',S));
+ end;
+end;
+
+function Permutation(n: Longint): TIntArray;
+var
+ I,J: integer;
+begin
+ if n<=0 then setlength(result,0)
+ else begin
+   result:=Permutation(n-1);
+   I:=random(n);
+   setlength(result,n);
+   for J:=n-1 downto I+1 do
+     result[J]:=result[J-1];
+   result[I]:=n-1;
+ end;
+end;
+
+// tParameterAttribut **********************************************************
+
+procedure tParameterAttribut.setzeKoordinate(ik: boolean);
+begin
+ if istKoordinate=ik then begin
+   write('Parameter ist bereits als ');
+   if not ik then write('nicht-');
+   writeln('Koordinate markiert!');
+   halt;
+ end;
+ istKoordinate:=ik;
+end;
+
+procedure tParameterAttribut.setzeUnabhaengig(iu: boolean);
+begin
+ if istUnabhaengig=iu then begin
+   write('Parameter ist bereits als ');
+   if iu then write('un');
+   writeln('abhängig markiert!');
+   halt;
+ end;
+ istUnabhaengig:=iu;
+end;
+
+procedure tParameterAttribut.setzeBenutzt(wb: boolean);
+begin
+ if wirdBenutzt=wb then begin
+   write('Parameter ist bereits als ');
+   if not wb then write('un');
+   writeln('benutzt markiert!');
+   halt;
+ end;
+ wirdBenutzt:=wb;
+end;
+
+procedure tParameterAttribut.fromChar(c: char);
+begin
+ if (c<'0') or (c>'7') then begin
+   writeln(''''+c+''' ist kein gültiger Wert für Parametereigenschaften, sondern nur 0..7.');
+   halt;
+ end;
+ istKoordinate:=odd(ord(c)-ord('0'));
+ istUnabhaengig:=odd((ord(c)-ord('0')) shr 1);
+ wirdBenutzt:=odd((ord(c)-ord('0')) shr 2);
+end;
+
+function tParameterAttribut.toChar: char;
+begin
+ result:=char(ord('0') + byte(istKoordinate) + 2*byte(istUnabhaengig) + 4*byte(wirdBenutzt));
+end;
+
+// tGenerikum ******************************************************************
+
+constructor tGenerikum.create;
+begin
+  inherited create;
+  fillchar(ID,sizeof(ID),#0);
+  index:=-1;
+end;
+
+destructor tGenerikum.destroy;
+begin
+  setlength(ID,0);
+  inherited destroy;
+end;
+
+procedure tGenerikum.init(g: tGenerikum);
+begin
+ ID:=g.ID;
+ index:=g.index;
+end;
+
+function tGenerikum.istGleich(g: tGenerikum): boolean;
+begin
+ result:=ID=g.ID; // Index wird absichtlich nicht mit überprüft, da die Reihenfolge im Array egal sein soll
+end;
+
+// tEreignis *******************************************************************
+
+function tEreignis.istDummy: boolean;
+begin
+  result:=(Art=eaDummy) or (Jahr=0);
+end;
+
+constructor tEreignis.create;
+begin
+ inherited create;
+ jahr:=0;
+ Art:=eaDummy;
+end;
+
+destructor tEreignis.destroy;
+begin
+ inherited destroy;
+end;
+
+procedure tEreignis.init(e: tGenerikum);
+begin
+ inherited init(e);
+ if not (e is tEreignis) then begin
+   writeln('Ereignis kann nicht mit nicht-Ereignis initialisiert werden!');
+   halt;
+ end;
+ jahr:=(e as tEreignis).Jahr;
+ Art:=(e as tEreignis).Art;
+end;
+
+function tEreignis.istGleich(e: tGenerikum): boolean;
+begin
+ result:=inherited istGleich(e);
+ if not (e is tEreignis) then begin
+   writeln('Ereignis kann nicht mit nicht-Ereignis verglichen werden!');
+   halt;
+ end;
+ result:=result and ((e as tEreignis).Jahr=Jahr) and ((e as tEreignis).Art=Art);
+end;
+
+// tPerson *********************************************************************
+
+constructor tPerson.create;
+var ea: tEreignisart;
+begin
+ inherited create;
+ Anfang:=nil;
+ Ende:=nil;
+ for ea:=low(ea) to high(ea) do
+   Ereignisse[ea]:=nil;
+ KindIn:=nil;
+ fillchar(ElterIn,sizeof(ElterIn),#0);
+ fillchar(inputIn,sizeof(inputIn),#0);
+ fillchar(outputIn,sizeof(outputIn),#0);
+ fillchar(Vorname,sizeof(Vorname),#0);
+ fillchar(Nachname,sizeof(Nachname),#0);
+ fillchar(inMMInteraktion,sizeof(inMMInteraktion),#0);
+ fillchar(inMFInteraktion,sizeof(inMFInteraktion),#0);
+ P1:=-1;
+ P2:=-1;
+ P3:=-1;
+end;
+
+destructor tPerson.destroy;
+var
+  i: longint;
+begin
+ if assigned(KindIn) then
+   KindIn.entferneKind(self);
+ for i:=0 to length(ElterIn)-1 do
+   if assigned(ElterIn[i]) then
+     ElterIn[i].entferneElter(self);
+ setlength(ElterIn,0);
+ setlength(Vorname,0);
+ setlength(Nachname,0);
+ if length(inMMInteraktion)<>0 then
+   raise Exception.create('Diese Person ist noch in einer MMInteraktion verzeichnet!');
+ setlength(inMMInteraktion,0);
+ if length(inMFInteraktion)<>0 then
+   raise Exception.create('Diese Person ist noch in einer MFInteraktion verzeichnet!');
+ setlength(inMFInteraktion,0);
+ inherited destroy;
+end;
+
+procedure tPerson.entferneElterIn(wo: tFamilie);
+var
+  i,j: longint;
+begin
+ for i:=length(ElterIn)-1 downto 0 do
+   if ElterIn[i]=wo then begin
+     for j:=i+1 to length(ElterIn)-1 do
+       ElterIn[j-1]:=ElterIn[j];
+     setlength(ElterIn,length(ElterIn)-1);
+   end;
+end;
+
+procedure tPerson.entferneKindIn(wo: tFamilie);
+begin
+ if KindIn=wo then
+   KindIn:=nil;
+end;
+
+procedure tPerson.fuegeInputInHinzu(wo: tVerknuepfung);
+var
+  i: longint;
+begin
+ for i:=0 to length(inputIn)-1 do
+   if inputIn[i]=wo then
+     writeln(inputIn[i+length(inputIn)].outP.id);
+ setlength(inputIn,length(inputIn)+1);
+ inputIn[length(inputIn)-1]:=wo;
+end;
+
+procedure tPerson.entferneInputIn(wo: tVerknuepfung);
+var
+  i,j: longint;
+begin
+ for i:=length(inputIn)-1 downto 0 do
+   if inputIn[i]=wo then begin
+     for j:=i+1 to length(inputIn)-1 do
+       inputIn[j-1]:=inputIn[j];
+     setlength(inputIn,length(inputIn)-1);
+   end;
+end;
+
+procedure tPerson.fuegeOutputInHinzu(wo: tVerknuepfung);
+var
+  i: longint;
+begin
+ for i:=0 to length(outputIn)-1 do
+   if outputIn[i]=wo then
+     writeln(outputIn[i+length(outputIn)].outP.id);
+ setlength(outputIn,length(outputIn)+1);
+ outputIn[length(outputIn)-1]:=wo;
+end;
+
+procedure tPerson.entferneOutputIn(wo: tVerknuepfung);
+var
+  i,j: longint;
+begin
+ for i:=length(outputIn)-1 downto 0 do
+   if outputIn[i]=wo then begin
+     for j:=i+1 to length(outputIn)-1 do
+       outputIn[j-1]:=outputIn[j];
+     setlength(outputIn,length(outputIn)-1);
+   end;
+end;
+
+procedure tPerson.fuegeInMMInteraktionHinzu(wo: tMMInteraktion);
+begin
+ setlength(inMMInteraktion,length(inMMInteraktion)+1);
+ inMMInteraktion[length(inMMInteraktion)-1]:=wo;
+end;
+
+procedure tPerson.entferneInMMInteraktion(wo: tMMInteraktion);
+var
+  i,j: longint;
+begin
+ for i:=length(inMMInteraktion)-1 downto 0 do
+   if inMMInteraktion[i]=wo then begin
+     for j:=i+1 to length(inMMInteraktion)-1 do
+       inMMInteraktion[j-1]:=inMMInteraktion[j];
+     setlength(inMMInteraktion,length(inMMInteraktion)-1);
+   end;
+end;
+
+procedure tPerson.fuegeInMFInteraktionHinzu(wo: tMFInteraktion);
+begin
+ setlength(inMFInteraktion,length(inMFInteraktion)+1);
+ inMFInteraktion[length(inMFInteraktion)-1]:=wo;
+end;
+
+procedure tPerson.entferneInMFInteraktion(wo: tMFInteraktion);
+var
+  i,j: longint;
+begin
+ for i:=length(inMFInteraktion)-1 downto 0 do
+   if inMFInteraktion[i]=wo then begin
+     for j:=i+1 to length(inMFInteraktion)-1 do
+       inMFInteraktion[j-1]:=inMFInteraktion[j];
+     setlength(inMFInteraktion,length(inMFInteraktion)-1);
+   end;
+end;
+
+procedure tPerson.init(p: tGenerikum);
+begin
+ inherited init(p);
+ if not (p is tPerson) then begin
+   writeln('Person kann nicht mit nicht-Person initialisiert werden!');
+   halt;
+ end;
+ Vorname:=(p as tPerson).Vorname;
+ Nachname:=(p as tPerson).Nachname;
+ P1:=(p as tPerson).P1;
+ P2:=(p as tPerson).P2;
+ P3:=(p as tPerson).P3;
+end;
+
+procedure tPerson.init(p: tGenerikum; var es: tEreignisArray);
+var
+  ea: tEreignisArt;
+begin
+ init(p);
+ Anfang:=FindeEreignis(es,pEreignisToStr((p as tPerson).Anfang));
+ Ende:=FindeEreignis(es,pEreignisToStr((p as tPerson).Ende));
+ for ea:=low(tEreignisArt) to high(tEreignisArt) do
+   Ereignisse[ea]:=FindeEreignis(es,pEreignisToStr((p as tPerson).Ereignisse[ea]));
+end;
+
+procedure tPerson.init(p: tGenerikum; var es: tEreignisArray; var fs: tFamilieArray);
+begin
+ init(p,es,fs,true);
+end;
+
+procedure tPerson.init(p: tGenerikum; var es: tEreignisArray; var fs: tFamilieArray; darfErzeugen: boolean);
+var
+  i,j: longint;
+begin
+ init(p,es);
+ KindIn:=findeFamilie(fs,pFamilieToStr((p as tPerson).KindIn),darfErzeugen);
+ if assigned(KindIn) and
+    not KindIn.hatKind(self) then begin
+   setlength(KindIn.Kinder,length(KindIn.Kinder)+1);
+   KindIn.Kinder[length(KindIn.Kinder)-1]:=self;
+ end;
+ setlength(ElterIn,length((p as tPerson).ElterIn));
+ for i:=length(ElterIn)-1 downto 0 do begin
+   ElterIn[i]:=findeFamilie(fs,pFamilieToStr((p as tPerson).ElterIn[i]),darfErzeugen);
+   if assigned(ElterIn[i]) and
+      not ElterIn[i].hatElter(self) then
+     ElterIn[i].Eltern[byte((p as tPerson).ElterIn[i].Eltern[1]=p)]:=self
+   else begin
+     for j:=i+1 to length(ElterIn)-1 do
+       ElterIn[j-1]:=ElterIn[j];
+     setlength(ElterIn,length(ElterIn)-1);
+   end;
+ end;
+end;
+
+function tPerson.anzahlVerbindungen: longint;
+begin
+ result:=length(ElterIn)+byte(assigned(KindIn));
+end;
+
+function tPerson.istGleich(p: tGenerikum): boolean;
+var
+  ea:      tEreignisart;
+  i,j,cnt: longint;
+begin
+ result:=inherited istGleich(p);
+ if not (p is tPerson) then begin
+   writeln('Person kann nicht mit nicht-Person verglichen werden!');
+   halt;
+ end;
+ result:=
+   result and
+   (Vorname=(p as tPerson).Vorname) and
+   (Nachname=(p as tPerson).Nachname) and
+   Anfang.istGleich((p as tPerson).Anfang) and
+   Ende.istGleich((p as tPerson).Ende);
+ for ea:=low(tEreignisArt) to high(tEreignisArt) do
+   result:=
+     result and ((Ereignisse[ea]=(p as tPerson).Ereignisse[ea]) or Ereignisse[ea].istGleich((p as tPerson).Ereignisse[ea]));
+ result:=result and (pFamilieToStr(KindIn)=pFamilieToStr((p as tPerson).KindIn));
+ result:=result and (length(ElterIn)=length((p as tPerson).ElterIn));
+ if result then
+   for i:=0 to length(ElterIn)-1 do begin
+     cnt:=0;
+     for j:=0 to length(ElterIn)-1 do
+       if pFamilieToStr(ElterIn[i])=pFamilieToStr((p as tPerson).ElterIn[j]) then
+         inc(cnt);
+     result:=result and (cnt=1);
+   end;
+end;
+
+function tPerson.elterVonFamilie(eNum: longint): tFamilie;
+var
+  i: longint;
+begin
+ result:=nil;
+ for i:=0 to length(elterIn)-1 do
+   if elterIn[i].Eltern[eNum]=self then begin
+     if result<>nil then begin
+       writeln('*** Warnung ***');
+       writeln('Rückgabewert nicht eindeutig, Person '+pPersonToStr(self)+' ist Elter '+inttostr(eNum)+' in mehreren Familien!');
+       exit;
+     end;
+     result:=elterIn[i];
+   end;
+end;
+
+function tPerson.istElterIn(f: tFamilie): boolean;
+var
+  i: longint;
+begin
+ result:=false;
+ for i:=0 to length(elterIn)-1 do
+   result:=result or (elterIn[i]=f);
+end;
+
+// tFamilie ********************************************************************
+
+constructor tFamilie.create;
+begin
+ inherited create;
+ Anfang:=nil;
+ Verheiratet:=false;
+ Eltern[0]:=nil;
+ Eltern[1]:=nil;
+ fillchar(Kinder,sizeof(Kinder),#0);
+ fillchar(inMFInteraktion,sizeof(inMFInteraktion),#0);
+ fillchar(inFFInteraktion,sizeof(inFFInteraktion),#0);
+end;
+
+destructor tFamilie.destroy;
+var
+  i: longint;
+begin
+ for i:=0 to length(Kinder)-1 do
+   if assigned(Kinder[i]) then
+     Kinder[i].entferneKindIn(self);
+ for i:=0 to length(Eltern)-1 do
+   if assigned(Eltern[i]) then
+     Eltern[i].entferneElterIn(self);
+ setlength(Kinder,0);
+ if length(inMFInteraktion)<>0 then
+   raise Exception.create('Diese Familie ist noch in einer MFInteraktion verzeichnet!');
+ setlength(inMFInteraktion,0);
+ if length(inFFInteraktion)<>0 then
+   raise Exception.create('Diese Familie ist noch in einer FFInteraktion verzeichnet!');
+ setlength(inFFInteraktion,0);
+ inherited destroy;
+end;
+
+procedure tFamilie.entferneElter(wen: tPerson);
+var
+  i,anz: longint;
+begin
+ anz:=0;
+ for i:=0 to length(Eltern)-1 do
+   if Eltern[i]=wen then begin
+     inc(anz);
+     Eltern[i]:=nil;
+   end;
+ if anz=0 then begin
+   writeln('Ich habe den Elter '''+wen.ID+''' nicht in Familie '''+ID+''' gefunden!');
+   halt;
+ end;
+ if anz>1 then begin
+   writeln('Ich habe den Elter '''+wen.ID+''' mehrmals in Familie '''+ID+''' gefunden!');
+   halt;
+ end;
+end;
+
+procedure tFamilie.entferneKind(wen: tPerson);
+var
+  i,j,anz: longint;
+begin
+ anz:=0;
+ for i:=length(Kinder)-1 downto 0 do
+   if Kinder[i]=wen then begin
+     inc(Anz);
+     Kinder[i]:=nil;
+     for j:=i+1 to length(Kinder)-1 do
+       Kinder[j-1]:=Kinder[j];
+     setlength(Kinder,length(Kinder)-1);
+   end;
+ if anz=0 then begin
+   writeln('Ich habe das Kind '''+wen.ID+''' nicht in Familie '''+ID+''' gefunden!');
+   halt;
+ end;
+ if anz>1 then begin
+   writeln('Ich habe das Kind '''+wen.ID+''' mehrmals in Familie '''+ID+''' gefunden!');
+   halt;
+ end;
+end;
+
+procedure tFamilie.fuegeInMFInteraktionHinzu(wo: tMFInteraktion);
+begin
+ setlength(inMFInteraktion,length(inMFInteraktion)+1);
+ inMFInteraktion[length(inMFInteraktion)-1]:=wo;
+end;
+
+procedure tFamilie.entferneInMFInteraktion(wo: tMFInteraktion);
+var
+  i,j: longint;
+begin
+ for i:=length(inMFInteraktion)-1 downto 0 do
+   if inMFInteraktion[i]=wo then begin
+     for j:=i+1 to length(inMFInteraktion)-1 do
+       inMFInteraktion[j-1]:=inMFInteraktion[j];
+     setlength(inMFInteraktion,length(inMFInteraktion)-1);
+   end;
+end;
+
+procedure tFamilie.fuegeInFFInteraktionHinzu(wo: tFFInteraktion);
+begin
+ setlength(inFFInteraktion,length(inFFInteraktion)+1);
+ inFFInteraktion[length(inFFInteraktion)-1]:=wo;
+end;
+
+procedure tFamilie.entferneInFFInteraktion(wo: tFFInteraktion);
+var
+  i,j: longint;
+begin
+ for i:=length(inFFInteraktion)-1 downto 0 do
+   if inFFInteraktion[i]=wo then begin
+     for j:=i+1 to length(inFFInteraktion)-1 do
+       inFFInteraktion[j-1]:=inFFInteraktion[j];
+     setlength(inFFInteraktion,length(inFFInteraktion)-1);
+   end;
+end;
+
+procedure tFamilie.init(f: tGenerikum);
+begin
+ inherited init(f);
+ if not (f is tFamilie) then begin
+   writeln('Familie kann nicht mit nicht-Familie initialisiert werden!');
+   halt;
+ end;
+ Verheiratet:=(f as tFamilie).Verheiratet;
+end;
+
+procedure tFamilie.init(f: tGenerikum; var Es: tEreignisArray; var Ps: tPersonArray);
+begin
+ init(f,Es,Ps,true);
+end;
+
+procedure tFamilie.init(f: tGenerikum; var Es: tEreignisArray; var Ps: tPersonArray; darfErzeugen: boolean);
+var
+  i,j: longint;
+begin
+ init(f);
+ Anfang:=findeEreignis(Es,pEreignisToStr((f as tFamilie).Anfang));
+ for i:=0 to 1 do begin
+   Eltern[i]:=findePerson(Ps,pPersonToStr((f as tFamilie).Eltern[i]),darfErzeugen);
+   if assigned(Eltern[i]) and
+      not Eltern[i].istElterIn(self) then begin
+     setlength(Eltern[i].ElterIn,length(Eltern[i].ElterIn)+1);
+     Eltern[i].ElterIn[length(Eltern[i].ElterIn)-1]:=self;
+   end;
+ end;
+ setlength(Kinder,length((f as tFamilie).Kinder));
+ for i:=length(Kinder)-1 downto 0 do begin
+   Kinder[i]:=findePerson(Ps,pPersonToStr((f as tFamilie).Kinder[i]),darfErzeugen);
+   if assigned(Kinder[i]) then
+     Kinder[i].KindIn:=self
+   else begin
+     for j:=i+1 to length(Kinder)-1 do
+       Kinder[j-1]:=Kinder[j];
+     setlength(Kinder,length(Kinder)-1);
+   end;
+ end;
+end;
+
+function tFamilie.anzahlVerbindungen: longint;
+var
+  i: longint;
+begin
+ result:=length(Kinder);
+ for i:=0 to 1 do
+   result:=result+byte(assigned(Eltern[i]));
+end;
+
+function tFamilie.istGleich(f: tGenerikum): boolean;
+var
+  i,j,cnt: longint;
+begin
+ result:=inherited istGleich(f);
+ if not (f is tFamilie) then begin
+   writeln('Familie kann nicht mit nicht-Familie verglichen werden!');
+   halt;
+ end;
+ result:=
+   result and
+   (Verheiratet=(f as tFamilie).Verheiratet) and
+   (Anfang.istGleich((f as tFamilie).Anfang));
+ for i:=0 to 1 do
+   result:=
+     result and
+     (pPersonToStr(Eltern[i])=pPersonToStr((f as tFamilie).Eltern[i]));
+ result:=result and (length(Kinder)=length((f as tFamilie).Kinder));
+ if result then
+   for i:=0 to length(Kinder)-1 do begin
+     cnt:=0;
+     for j:=0 to length(Kinder)-1 do
+       if pPersonToStr(Kinder[i])=pPersonToStr((f as tFamilie).Kinder[j]) then
+         inc(cnt);
+     result:=result and (cnt=1);
+   end;
+end;
+
+function tFamilie.hatKind(p: tPerson): boolean;
+var
+  i: longint;
+begin
+ result:=false;
+ for i:=0 to length(Kinder)-1 do
+   result:=result or (Kinder[i]=p);
+end;
+
+function tFamilie.hatElter(p: tPerson): boolean;
+begin
+ result:=(Eltern[0]=p) or (Eltern[1]=p);
+end;
+
+// tVerknuepfung ***************************************************************
+
+procedure tVerknuepfung.wOutP(p: tPerson);
+begin
+ if assigned(outP) then begin
+   if assigned(outP.KindIn) then begin
+     if assigned(outP.KindIn.Eltern[0]) then
+       outP.KindIn.Eltern[0].entferneInputIn(self);
+     if assigned(outP.KindIn.Eltern[1]) then
+       outP.KindIn.Eltern[1].entferneInputIn(self);
+     outP.entferneOutputIn(self);
+   end;
+ end;
+ _outP:=p;
+ if assigned(outP) then begin
+   if assigned(outP.KindIn) then begin
+     if assigned(outP.KindIn.Eltern[0]) then
+       outP.KindIn.Eltern[0].fuegeInputInHinzu(self);
+     if assigned(outP.KindIn.Eltern[1]) then
+       outP.KindIn.Eltern[1].fuegeInputInHinzu(self);
+     outP.fuegeOutputInHinzu(self);
+   end;
+ end;
+end;
+
+destructor tVerknuepfung.destroy;
+begin
+ if assigned(outP) then begin
+   if assigned(outP.KindIn) then begin
+     if assigned(outP.KindIn.Eltern[0]) then
+       outP.KindIn.Eltern[0].entferneInputIn(self);
+     if assigned(outP.KindIn.Eltern[1]) then
+       outP.KindIn.Eltern[1].entferneInputIn(self);
+   end;
+   outP.entferneOutputIn(self);
+ end;
+ inherited destroy;
+end;
+
+function tVerknuepfung.istGleich(v: tVerknuepfung; p2p: tIntArray): boolean;
+var
+  i: longint;
+  c: char;
+begin
+ result:=
+   (pPersonToStr(outP)=pPersonToStr(v.outP)) and
+   paramsGleich(Lambda,v.Lambda,p2p);
+ for c:='x' to 'y' do begin
+   result:=result and paramsGleich(Output[c],v.Output[c],p2p);
+   for i:=0 to 1 do
+     result:=result and paramsGleich(Input[i,c],v.Input[i,c],p2p);
+ end;
+end;
+
+// tMMInteraktion **************************************************************
+
+function tMMInteraktion.r_Ps(i: longint): tPerson;
+begin
+ result:=__Ps[i];
+end;
+
+procedure tMMInteraktion.w_Ps(i: longint; p: tPerson);
+begin
+ if assigned(_Ps[i]) then
+   _Ps[i].entferneInMMInteraktion(self);
+ __Ps[i]:=p;
+ if assigned(_Ps[i]) then
+   _Ps[i].fuegeInMMInteraktionHinzu(self);
+end;
+
+function tMMInteraktion.istGleich(ia: tMMInteraktion): boolean;
+var
+  i: longint;
+begin
+ result:=Laenge=ia.Laenge;
+ for i:=0 to 1 do
+   result:=result and (pPersonToStr(_Ps[i])=pPersonToStr(ia._Ps[i]));
+end;
+
+destructor tMMInteraktion.destroy;
+begin
+ if assigned(_Ps[0]) then
+   _Ps[0].entferneInMMInteraktion(self);
+ if assigned(_Ps[1]) then
+   _Ps[1].entferneInMMInteraktion(self);
+ inherited destroy;
+end;
+
+// tMFInteraktion **************************************************************
+
+procedure tMFInteraktion.w_P(p: tPerson);
+begin
+ if assigned(_P) then
+   _P.entferneInMFInteraktion(self);
+ __P:=p;
+ if assigned(_P) then
+   _P.fuegeInMFInteraktionHinzu(self);
+end;
+
+procedure tMFInteraktion.w_F(f: tFamilie);
+begin
+ if assigned(_F) then
+   _F.entferneInMFInteraktion(self);
+ __F:=f;
+ if assigned(_F) then
+   _F.fuegeInMFInteraktionHinzu(self);
+end;
+
+function tMFInteraktion.istGleich(ia: tMFInteraktion): boolean;
+begin
+ result:=
+   (Laenge=ia.Laenge) and
+   (pPersonToStr(_P)=pPersonToStr(ia._P)) and
+   (pFamilieToStr(_F)=pFamilieToStr(ia._F));
+end;
+
+destructor tMFInteraktion.destroy;
+begin
+ if assigned(_P) then
+   _P.entferneInMFInteraktion(self);
+ if assigned(_F) then
+   _F.entferneInMFInteraktion(self);
+ inherited destroy;
+end;
+
+// tFFInteraktion **************************************************************
+
+function tFFInteraktion.r_Fs(i: longint): tFamilie;
+begin
+ result:=__Fs[i];
+end;
+
+procedure tFFInteraktion.w_Fs(i: longint; f: tFamilie);
+begin
+ if assigned(_Fs[i]) then
+   _Fs[i].entferneInFFInteraktion(self);
+ __Fs[i]:=f;
+ if assigned(_Fs[i]) then
+   _Fs[i].fuegeInFFInteraktionHinzu(self);
+end;
+
+function tFFInteraktion.istGleich(ia: tFFInteraktion): boolean;
+var
+  i: longint;
+begin
+ result:=true;
+ for i:=0 to 1 do
+   result:=result and (pFamilieToStr(_Fs[i])=pFamilieToStr(ia._Fs[i]));
+end;
+
+destructor tFFInteraktion.destroy;
+begin
+ if assigned(_Fs[0]) then
+   _Fs[0].entferneInFFInteraktion(self);
+ if assigned(_Fs[1]) then
+   _Fs[1].entferneInFFInteraktion(self);
+ inherited destroy;
+end;
+
+// tZusammenhangskomponente ****************************************************
+constructor tZusammenhangskomponente.create;
+begin
+ inherited create;
+ fillchar(Familien,sizeof(Familien),#0);
+ setlength(Familien,0);
+end;
+
+destructor tZusammenhangskomponente.destroy;
+begin
+ setlength(Familien,0);
+ inherited destroy;
+end;
+
+function tZusammenhangskomponente.grenztAn(p: tPerson): boolean;
+var i,j: longint;
+begin
+ result:=false;
+ for i:=0 to length(Familien)-1 do begin
+   for j:=0 to 1 do
+     result:=result or (assigned(Familien[i].Eltern[j]) and (p.ID=Familien[i].Eltern[j].ID));
+   for j:=0 to length(Familien[i].Kinder)-1 do
+     result:=result or (p.ID=Familien[i].Kinder[j].ID);
+ end;
+end;
+
+procedure tZusammenhangskomponente.verschmelzeMit(zhk: tZusammenhangskomponente);
+var i,j:      longint;
+    gefunden: boolean;
+begin
+ for i:=0 to length(zhk.Familien)-1 do begin
+   gefunden:=false;
+   for j:=0 to length(Familien)-1 do
+     gefunden:=gefunden or (zhk.Familien[i].ID=Familien[j].ID);
+   if not gefunden then begin
+     setlength(Familien,length(Familien)+1);
+     Familien[length(Familien)-1]:=zhk.Familien[i];
+   end;
+ end;
+end;
+
+procedure tZusammenhangskomponente.UmfeldEinfuegen(Fs: tFamilieArray; p: tPerson);
+var i,j:      longint;
+    gefunden: boolean;
+begin
+ for i:=0 to length(Fs)-1 do begin
+   gefunden:=false;
+   for j:=0 to 1 do
+     gefunden:=gefunden or (assigned(Fs[i].Eltern[j]) and (p.ID=Fs[i].Eltern[j].ID));
+   for j:=0 to length(Fs[i].Kinder)-1 do
+     gefunden:=gefunden or (p.ID=Fs[i].Kinder[j].ID);
+   if gefunden then begin
+     for j:=0 to length(Familien)-1 do
+       gefunden:=gefunden and (Familien[j].ID <> Fs[i].ID);
+     if gefunden then begin
+       setlength(Familien,length(Familien)+1);
+       Familien[length(Familien)-1]:=Fs[i];
+     end;
+   end;
+ end;
+end;
+
+// tGraph **********************************************************************
+
+constructor tGraph.create;
+begin
+ inherited create;
+ fillchar(Ecken,sizeof(Ecken),#0);
+ setlength(Ecken,0);
+ fillchar(Kanten,sizeof(Kanten),#0);
+ setlength(Kanten,0);
+end;
+
+destructor tGraph.destroy;
+begin
+ setlength(Ecken,0);
+ setlength(Kanten,0);
+end;
+
+function tGraph.entferneBlaetter(var f: tIntArray): tIntArray;
+var i,j,n1,n2,anz: longint;
+    gefunden:      boolean;
+begin
+ setlength(result,0);
+ anz:=0;
+ repeat
+   gefunden:=false;
+   for i:=length(f)-1 downto 0 do begin // nur Kanten, die noch dabei sind, können gelöscht werden
+     n1:=0;
+     n2:=0;
+     for j:=0 to length(f)-1 do begin // angrenzende Kanten, die noch dabei sind, zählen
+       n1:=n1 + byte((Kanten[f[j]].x=Kanten[f[i]].x) or (Kanten[f[j]].y=Kanten[f[i]].x));
+       n2:=n2 + byte((Kanten[f[j]].x=Kanten[f[i]].y) or (Kanten[f[j]].y=Kanten[f[i]].y));
+     end;
+     if (n1<=1) or (n2<=1) then begin // nur die Kante i selbst hängt an einer ihrer Ecken
+       gefunden:=true;
+       if anz>=length(result) then
+         setlength(result,anz+1024);
+       result[anz]:=f[i];
+       inc(anz);
+       for j:=i+1 to length(f)-1 do // aus dem Rennen
+         f[j-1]:=f[j];
+       setlength(f,length(f)-1);
+     end;
+   end;
+ until not gefunden;
+ setlength(result,anz);
+end;
+
+function tGraph.Pfadigkeit(Ks: tIntArray; a,b: longint): longint; // 0 -> zu wenig; 1 -> ein Pfad; 2-> zu viel
+var i,j,k,ich,letzter: longint;
+begin
+ ich:=a;
+ letzter:=-1;
+ repeat
+   j:=-1;
+   k:=0;
+   for i:=0 to length(Ks)-1 do begin
+     if (Kanten[Ks[i]].x=ich) and (Kanten[Ks[i]].y<>letzter) then begin // vorwärts immer, rückwärts nimmer
+       j:=Ks[i];
+       inc(k);
+     end;
+     if (Kanten[Ks[i]].y=ich) and (Kanten[Ks[i]].x<>letzter) then begin // vorwärts immer, rückwärts nimmer
+       j:=Ks[i];
+       inc(k);
+     end;
+   end;
+   if k=0 then begin // hier geht es nicht weiter
+     result:=0;
+     exit;
+   end;
+   if k>1+byte((letzter=-1) and (a=b)) then begin // hier gibt es eine Weggabelung
+     result:=2;
+     exit;
+   end;
+   if Kanten[j].x=ich then begin
+     letzter:=ich;
+     ich:=Kanten[j].y;
+   end
+   else begin
+     letzter:=ich;
+     ich:=Kanten[j].x;
+   end;
+ until ich=b;
+ result:=1;
+end;
+
+function tGraph.etwasDoppelt: boolean;
+var Ks: tIntArray;
+    i:  longint;
+begin
+ setlength(Ks,length(Kanten));
+ for i:=0 to length(Ks)-1 do
+   Ks[i]:=i;
+ result:=etwasDoppelt(Ks);
+end;
+
+function tGraph.etwasDoppelt(Ks: tIntArray): boolean;
+var i,j: longint;
+begin
+ result:=false;
+ for i:=0 to length(Ks)-2 do
+   for j:=i+1 to length(Ks)-1 do
+     result:=
+       result or
+       ((Kanten[Ks[i]].x = Kanten[Ks[j]].x) and (Kanten[Ks[i]].y = Kanten[Ks[j]].y)) or
+       ((Kanten[Ks[i]].x = Kanten[Ks[j]].y) and (Kanten[Ks[i]].y = Kanten[Ks[j]].x));
+end;
+
+function tGraph.etwasRedundant(Ks1,Ks2: tIntArray): boolean;
+var i,j: longint;
+begin
+ result:=false;
+ for i:=0 to length(Ks1)-1 do
+   for j:=0 to length(Ks2)-1 do
+     result:=
+       result or
+       ((Kanten[Ks1[i]].x = Kanten[Ks2[j]].x) and (Kanten[Ks1[i]].y = Kanten[Ks2[j]].y)) or
+       ((Kanten[Ks1[i]].x = Kanten[Ks2[j]].y) and (Kanten[Ks1[i]].y = Kanten[Ks2[j]].x));
+end;
+
+procedure tGraph.dumpKantenArray(Ks: tIntArray);
+var
+  i: longint;
+begin
+ writeln(length(Ks));
+ for i:=0 to length(Ks)-1 do
+   writeln(' '+inttostr(Kanten[Ks[i]].x)+' -- '+inttostr(Kanten[Ks[i]].y));
+end;
+
+function tGraph.findeKreise: tIntArrayArray;
+var Farben: tIntArray;
+    i:      longint;
+begin
+ setlength(result,0);
+ setlength(Farben,length(Kanten));
+ for i:=0 to length(Farben)-1 do  // alles noch dabei
+   Farben[i]:=i;
+ entferneBlaetter(Farben);
+ if length(Farben)>0 then begin
+   result:=findeKreise(Farben);
+   exit;
+ end;
+end;
+
+function tGraph.findeKreise(f: tIntArray): tIntArrayArray;
+var j,k,l,m:   longint;
+    loeschung,
+    sicherung: tIntArray;
+begin
+ setlength(result,0);
+ setlength(sicherung,length(f)-1);
+ for j:=0 to length(sicherung)-1 do
+   sicherung[j]:=f[j];
+ loeschung:=entferneBlaetter(sicherung);
+ if length(sicherung)>0 then begin // es sind noch Kanten da, also auch noch Kreise!
+   result:=findeKreise(sicherung); // alle bisher gefundenen Kreise
+   setlength(sicherung,length(sicherung)+length(loeschung)+1);
+   for j:=0 to length(loeschung)-1 do  // alle gelöschten Kanten wieder einfügen ...
+     sicherung[length(sicherung)-j-2]:=loeschung[j];
+   sicherung[length(sicherung)-1]:=f[length(f)-1]; // ... wirklich alle!
+   for j:=0 to length(result)-1 do begin         // jedem Kreis, der noch in sicherung ist ...
+     m:=-1;
+     for k:=0 to length(result[j])-1 do
+       if m=-1 then
+         for l:=0 to length(sicherung)-1 do
+           if sicherung[l]=result[j,k] then begin // die l-te Kante der Sicherung ist im j-ten Kreis (die k-te Kante)
+             m:=l;
+             break;
+           end;
+     if m=-1 then begin
+       writeln('interessanter Weise habe ich keine Kanten gefunden ...');
+       halt(1);
+     end;
+     for k:=m+1 to length(sicherung)-1 do        // ... wird eine noch vorhandene Kante gelöscht ...
+       sicherung[k-1]:=sicherung[k];
+     setlength(sicherung,length(sicherung)-1);
+     entferneBlaetter(sicherung);                // ... und dann die Blätter entfernt
+   end;
+   // jetzt sollte ein einziger, "neuer", Kreis verblieben sein
+   if pfadigkeit(sicherung,Kanten[sicherung[0]].x,Kanten[sicherung[0]].x)<>1 then begin
+     writeln('Die Pfadigkeit ist '+inttostr(pfadigkeit(sicherung,Kanten[sicherung[0]].x,Kanten[sicherung[0]].x))+' und nicht 1!');
+     writeln('Der Programmierer hat sich geirrt.'); // offenbar ist es kein einfacher Kreis :-/
+     halt(1);
+   end;
+   setlength(result,length(result)+1);
+   setlength(result[length(result)-1],length(sicherung));
+   for j:=0 to length(sicherung)-1 do
+     result[length(result)-1,j]:=sicherung[j];
+   exit;
+ end;
+
+ setlength(result,1);  // es war der letzte Kreis
+ setlength(result[0],length(loeschung)+1);
+ for j:=0 to length(loeschung)-1 do
+   result[0,j]:=loeschung[j];
+ result[0,length(loeschung)]:=f[length(f)-1];
+
+ if pfadigkeit(result[0],Kanten[result[0,0]].x,Kanten[result[0,0]].x)<>1 then begin
+   writeln('Die Pfadigkeit ist '+inttostr(pfadigkeit(result[0],Kanten[result[0,0]].x,Kanten[result[0,0]].x))+' und nicht 1!');
+   writeln('Der Programmierer hat sich geirrt.'); // offenbar ist es kein einfacher Kreis :-/
+   writeln('f:');
+   dumpKantenArray(f);
+   writeln('result[0]:');
+   dumpKantenArray(result[0]);
+   writeln('loeschung:');
+   dumpKantenArray(loeschung);
+   halt(1);
+ end;
+end;
+
+// tSortObject *****************************************************************
+
+constructor tSortObject.create;
+begin
+ inherited create;
+ oG:=nil;
+ oMM:=nil;
+ oMF:=nil;
+ oFF:=nil;
+ oV:=nil;
+ fillchar(ID,sizeof(ID),#0);
+ ID:='';
+end;
+
+procedure tSortObject.assign(g: tGenerikum);
+begin
+ oG:=g;
+ oMM:=nil;
+ oMF:=nil;
+ oFF:=nil;
+ oV:=nil;
+ ID:=sortStringFromObject(g);
+end;
+
+procedure tSortObject.assign(i: tMMInteraktion);
+begin
+ oG:=nil;
+ oMM:=i;
+ oMF:=nil;
+ oFF:=nil;
+ oV:=nil;
+ ID:=sortStringFromObject(oMM);
+end;
+
+procedure tSortObject.assign(i: tMFInteraktion);
+begin
+ oG:=nil;
+ oMM:=nil;
+ oMF:=i;
+ oFF:=nil;
+ oV:=nil;
+ ID:=sortStringFromObject(oMF);
+end;
+
+procedure tSortObject.assign(i: tFFInteraktion);
+begin
+ oG:=nil;
+ oMM:=nil;
+ oMF:=nil;
+ oFF:=i;
+ oV:=nil;
+ ID:=sortStringFromObject(oFF);
+end;
+
+procedure tSortObject.assign(v: tVerknuepfung);
+begin
+ oG:=nil;
+ oMM:=nil;
+ oMF:=nil;
+ oFF:=nil;
+ oV:=v;
+ ID:=sortStringFromObject(oV);
+end;
+
+// allgemeine Funktionen *******************************************************
+
+function sortStringFromObject(g: tGenerikum): string;
+begin
+ result:=g.ID;
+end;
+
+function sortStringFromObject(i: tMMInteraktion): string;
+begin
+ result:=pPersonToStr(i._Ps[0])+','+pPersonToStr(i._Ps[1]);
+end;
+
+function sortStringFromObject(i: tMFInteraktion): string;
+begin
+ result:=pPersonToStr(i._P)+','+pFamilieToStr(i._F);;
+end;
+
+function sortStringFromObject(i: tFFInteraktion): string;
+begin
+ result:=pFamilieToStr(i._Fs[0])+','+pFamilieToStr(i._Fs[1]);
+end;
+
+function sortStringFromObject(v: tVerknuepfung): string;
+begin
+ result:=pPersonToStr(v.outP);
+end;
+
+function sortiere(arr: tGenerikumArray): tGenerikumArray; overload; inline;
+var
+  saIn,saOut: tSortObjectArray;
+  i:          longint;
+begin
+ setlength(saIn,length(arr));
+ for i:=0 to length(saIn)-1 do begin
+   saIn[i]:=tSortObject.create;
+   saIn[i].assign(arr[i]);
+ end;
+ saOut:=sortiere(saIn);
+ setlength(result,length(saOut));
+ for i:=0 to length(result)-1 do begin
+   result[i]:=saOut[i].oG;
+   saOut[i].free;
+ end;
+ setlength(saIn,0);
+ setlength(saOut,0);
+end;
+
+function sortiere(arr: tMMInteraktionArray): tMMInteraktionArray; overload; inline;
+var
+  saIn,saOut: tSortObjectArray;
+  i:          longint;
+begin
+ setlength(saIn,length(arr));
+ for i:=0 to length(saIn)-1 do begin
+   saIn[i]:=tSortObject.create;
+   saIn[i].assign(arr[i]);
+ end;
+ saOut:=sortiere(saIn);
+ setlength(result,length(saOut));
+ for i:=0 to length(result)-1 do begin
+   result[i]:=saOut[i].oMM;
+   saOut[i].free;
+ end;
+ setlength(saIn,0);
+ setlength(saOut,0);
+end;
+
+function sortiere(arr: tMFInteraktionArray): tMFInteraktionArray; overload; inline;
+var
+  saIn,saOut: tSortObjectArray;
+  i:          longint;
+begin
+ setlength(saIn,length(arr));
+ for i:=0 to length(saIn)-1 do begin
+   saIn[i]:=tSortObject.create;
+   saIn[i].assign(arr[i]);
+ end;
+ saOut:=sortiere(saIn);
+ setlength(result,length(saOut));
+ for i:=0 to length(result)-1 do begin
+   result[i]:=saOut[i].oMF;
+   saOut[i].free;
+ end;
+ setlength(saIn,0);
+ setlength(saOut,0);
+end;
+
+function sortiere(arr: tFFInteraktionArray): tFFInteraktionArray; overload; inline;
+var
+  saIn,saOut: tSortObjectArray;
+  i:          longint;
+begin
+ setlength(saIn,length(arr));
+ for i:=0 to length(saIn)-1 do begin
+   saIn[i]:=tSortObject.create;
+   saIn[i].assign(arr[i]);
+ end;
+ saOut:=sortiere(saIn);
+ setlength(result,length(saOut));
+ for i:=0 to length(result)-1 do begin
+   result[i]:=saOut[i].oFF;
+   saOut[i].free;
+ end;
+ setlength(saIn,0);
+ setlength(saOut,0);
+end;
+
+function sortiere(arr: tVerknuepfungArray): tVerknuepfungArray; overload; inline;
+var
+  saIn,saOut: tSortObjectArray;
+  i:          longint;
+begin
+ setlength(saIn,length(arr));
+ for i:=0 to length(saIn)-1 do begin
+   saIn[i]:=tSortObject.create;
+   saIn[i].assign(arr[i]);
+ end;
+ saOut:=sortiere(saIn);
+ setlength(result,length(saOut));
+ for i:=0 to length(result)-1 do begin
+   result[i]:=saOut[i].oV;
+   saOut[i].free;
+ end;
+ setlength(saIn,0);
+ setlength(saOut,0);
+end;
+
+function sortiere(arr: tSortObjectArray): tSortObjectArray;
+var
+  i:     longint;
+  mi,ma: string;
+begin
+ setlength(result,length(arr));
+ if length(arr)=0 then exit;
+ mi:=arr[0].ID;
+ ma:=arr[0].ID;
+ for i:=0 to length(result)-1 do begin
+   result[i]:=arr[i];
+   if cmpStr(mi,arr[i].ID)>0 then
+     mi:=arr[i].ID;
+   if cmpStr(ma,arr[i].ID)<0 then
+     ma:=arr[i].ID;
+ end;
+ sortiere(result,0,length(result)-1,mi,ma);
+end;
+
+procedure sortiere(var arr: tSortObjectArray; von,bis: longint; mi,ma: string);
+var
+  li,re: longint;
+  pivot: string;
+  tmp:   tSortObject;
+begin
+ if (von>=bis) or (mi=ma) then exit;
+ li:=von;
+ re:=bis;
+ pivot:=mitte(mi,ma);
+
+ while li<=re do begin
+   while (li<=re) and
+         (cmpStr(arr[li].ID,pivot)<=0) do
+     inc(li);
+   while (li<=re) and
+         (cmpStr(arr[re].ID,pivot)>=0) do
+     dec(re);
+   if li>=re then continue;
+   tmp:=arr[li];
+   arr[li]:=arr[re];
+   arr[re]:=tmp;
+   tmp:=nil;
+   inc(li);
+   dec(re);
+ end;
+ if li<>re+1 then begin
+   writeln('Fehler bei der Pivotisierung: li='+inttostr(li)+' und re='+inttostr(re));
+   halt;
+ end;
+ sortiere(arr,von,li-1,mi,pivot);
+ sortiere(arr,re+1,bis,pivot,ma);
+end;
+
+end.