DBR Delphi-Ecke

// Mit einem TList-Objekt wird eine Liste von Objekten gespeichert und
// verwaltet. TList führt dafür verschiedene Eigenschaften und Methoden
// ein:
// • Objekte zur Liste hinzufügen
// • Objekte aus der Liste entfernen
// • Objekte in der Liste finden
// • Objekte in der Liste sortieren
// Die Objekte werden durch Pointer referenziert. Das heisst, dass TList
// eine Liste von Pointern ist. Somit muss beim Aufnehmen eines Objektes
// erst einmal ein Speicherbereich allociert werden. Das geschieht bei
// TList mittels "New". Um Funktionen wie das Sortieren durchführen zu
// können, müssen die aufgenommenen Objekte vom gleichen Typ sein, es sei
// denn, man trickst etwas wie im unteren Beispiel. Dort werden zwei
// verschiedene Records verwendet, welche aber bis zu einem gewissen Punkt
// ganz genauso aufgebaut sind. Außerdem wurde am Anfang ein Byte
// eingeschoben, über welches der Typ des Records abgefragt werden kann.

// Getestet mit D4 unter XP

type 
  w = packed record 
    typ: byte; // erste Stelle im Record 
    d: double; 
    s: Shortstring; 
    i: integer; 
    c: char; 
  end; 
 
  n = packed record 
    typ: byte; // erste Stelle im Record 
    z: double; // Typ u. Position wie im oberen Record 
    c: Shortstring; // Typ u. Position wie oben, Typen davor genauso 
  end; 
 
  pwerte = ^w; 
  pnew = ^n; 
 
var 
  Liste: TList; 
  Werte: pwerte; // 1. 
  Neu: pnew; // 2. 
 
// Instanz erzeugen 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Liste := TList.create; 
end; 
 
// freigegeben 
 
procedure TForm1.FormDestroy(Sender: TObject); 
var 
  x: integer; 
begin 
  for x := 0 to Liste.count - 1 do 
    Dispose(Liste[x]); 
  Liste.free; 
end; 
 
// Hinzufügen und anzeigen 
 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  idx: integer; 
begin 
  new(Werte); 
  Werte^.typ := 1; 
  Werte^.c := #1; 
  Werte^.i := 220; 
  Werte^.d := 2.0; 
  Werte^.s := 'ITEM'; 
  idx := Liste.Add(Werte); // idx wird 0 (bei leerer Liste) 
 
  new(Werte); 
  Werte^.typ := 1; 
  Werte^.c := #255; 
  Werte^.i := 444; 
  Liste.Insert(0, Werte); 
  Werte^.d := 8.8; 
  Werte^.s := 'DBR'; 
 
  new(Neu); // der zweite Zeiger 
  Neu^.typ := 2; // hat die Zahl 2 
  Neu^.z := 7.01; 
  Neu^.c := 'Versuch "neuer Zeiger"'; 
  idx := Liste.Add(Neu); // idx wird jetzt 2 (bei leerer Liste) 
 
  new(Werte); 
  Liste.Add(Werte); 
  Werte^.typ := 1; 
  Werte^.i := 123; 
  Werte^.d := 45.67; 
  Werte^.s := 'Das ist ein Test'; 
  Werte^.c := 'A'; 
 
  if Liste.IndexOf(Neu) < 0 // ist "Neu" noch nicht in der Liste ? 
    then begin 
    new(Neu); 
    Neu^.typ := 2; 
    Liste.Add(Neu); 
    Neu^.z := 99; 
    Neu^.c := 'XY'; 
  end else showmessage('zweites "Neu" wurde nicht eingetragen'); 
 
  showmessage(pwerte(Liste[0])^.s); // 'DBR' 
  Werte := Liste[1]; 
  showmessage(Werte^.s); // 'ITEM' 
 
  showmessage(pnew(Liste[idx])^.c); // 'Versuch "neuer Zeiger"' 
 
  showmessage(pwerte(Liste.Last)^.s); // 'Das ist ein Test' 
end; 
 
// Sortierfunktion für Strings 
 
function Compare_S(Item1, Item2: pwerte): Integer; 
begin 
  result := Comparetext(item1.s, item2.s); 
end; 
 
// Sortierfunktion für Double 
 
function Compare_D(Item1, Item2: pwerte): Integer; 
begin 
  if item1.d = item2.d then result := 0 else 
    result := ord(Item1.d > Item2.d) * 2 - 1; 
end; 
 
// Sortieren und anzeigen 
 
procedure TForm1.Button8Click(Sender: TObject); 
var 
  x: integer; 
begin 
  if Liste.Count < 4 then exit; 
 
// nach Double-Werten sortieren 
  Liste.Sort(@Compare_D); 
 
// und anzeigen trotz unterschiedlicher Typen 
  for x := 0 to 3 do 
    showmessage(floattostr(pwerte(Liste[x])^.d)); 
 
// nach Strings sortieren 
  Liste.Sort(@Compare_S); 
 
// anzeigen 
  for x := 0 to 2 do 
    showmessage(pnew(Liste[x])^.c); // obwohl vom Typ "pwerte" 
 
  showmessage(pwerte(Liste[3])^.s); // obwohl vom Typ "pnew" 
end; 
 
// Typ-Abfrage 
 
procedure TForm1.Button6Click(Sender: TObject); 
var 
  p: PByte; // "typ" ist vom Typ Byte 
  x: integer; 
begin 
  for x := 0 to Liste.count - 1 do begin 
    p := Liste[x]; 
    showmessage('Items[' + inttostr(x) + '] hat den Typ ' + inttostr(p^)); 
  end; 
end; 
 
// Einen Zeiger + Objekt löschen 
 
procedure TForm1.Button7Click(Sender: TObject); 
begin 
  if Liste.Count = 0 then exit; 
  showmessage(pwerte(Liste[0])^.s); 
  Dispose(Liste[0]); // Speicher freigeben 
  Liste.Delete(0); // Zeiger aus Liste entfernen 
  if Liste.Count = 0 then exit; 
  showmessage(pwerte(Liste[0])^.s); 
end;