// Es wird eine Möglichkeit gezeigt, ein dynamisches Array in einem
// Objekt
(class) zu verwalten. Die Besonderheit dabei ist, dass man
//
(falls man will) lesend über eine Eigenschaft (property) auf ein Element
// des Arrays zugreifen kann. Dazu gibt man einen Index in eckigen Klammern
// an. Man könnte das auch über eine Prozedur machen
(hier auskommentiert),
// es ist aber mittels Klammer-Index bequemer.


// Getestet mit D4 unter XP

type 
  s25 = string[25]; 
 
  TTest = record 
    i: integer; 
    s: s25; 
    d: double; 
  end; 
 
  TMArr = array of TTest; 
 
  TMyObject = class(TObject) 
    FArr: TMArr; 
    FS: string; 
    FHlp: TTest; 
    FI: Integer; 
    function long: Word; 
    procedure fehler(i: Integer); 
    procedure addOne(value: TTest); 
    function getOne(idx: Word): TTest; 
    function delOne(idx: Word): boolean; 
    procedure chgOne(idx: Word; i: integer; s: shortstring; d: double); 
  protected 
    destructor Destroy; override; 
  public 
    procedure deleteAll;
    property Count: Word read long; 
//  procedure takeOne(idx: word; var t: TTest); 
    property readOne[idx: Word]: TTest read getOne; 
    property deleteOne[idx: Word]: boolean read delOne; 
    procedure addElements(i: integer; s: shortstring; d: double); 
    procedure changeOne(idx: Word; i: integer; s: shortstring; d: double); 
    procedure insertElements(idx: Word; i: integer; s: shortstring; d: double); 
  end; 
 
procedure TMyObject.deleteAll; 
begin 
  FArr := nil; 
end; 
 
destructor TMyObject.Destroy; 
begin 
  deleteAll; 
  inherited Destroy; 
end; 
 
procedure TMyObject.fehler(i: integer); 
begin 
  case i of 
    1: FS := 'Index zu hoch'; 
    2: FS := 'Array ausgelastet'; 
    3: FS := 'Insert fehlgeschlagen'; 
  end; 
  raise exception.create(FS); 
end; 
 
function TMyObject.long: Word; 
begin 
  result := length(FArr); 
end; 
 
procedure TMyObject.addOne(value: TTest); 
begin 
  FI := long; 
  if FI < MaxWord then begin 
    setlength(FArr, succ(FI)); 
    FArr[FI] := value; 
  end else fehler(2); 
end; 
 
procedure TMyObject.addElements(i: integer; s: shortstring; d: double); 
begin 
  FHlp.i := i; 
  FHlp.s := s; 
  FHlp.d := d; 
  addOne(FHlp); 
end; 
 
function TMyObject.delOne(idx: Word): boolean; 
var x: integer; 
begin 
  FI := long; 
  result := false; 
  if idx < long then begin 
    try 
      for x := idx to pred(FI) do 
        FArr[x] := FArr[x + 1]; 
      setlength(FArr, pred(FI)); 
      result := true; 
    except 
    end; 
  end else fehler(1); 
end; 
 
procedure TMyObject.insertElements(idx: Word; 
  i: integer; s: shortstring; d: double); 
var x: integer; 
begin 
  FI := long; 
  if idx = FI then addElements(i, s, d) 
  else if idx < FI then begin 
    try 
      setlength(FArr, succ(FI)); 
      for x := FI downto succ(idx) do 
        FArr[x] := FArr[x - 1]; 
      chgOne(idx, i, s, d); 
    except 
      fehler(3); 
    end; 
  end else fehler(1); 
end; 
 
procedure TMyObject.chgOne(idx: Word; 
  i: integer; s: shortstring; d: double); 
begin 
  FArr[idx].i := i; 
  FArr[idx].s := s; 
  FArr[idx].d := d; 
end; 
 
procedure TMyObject.changeOne(idx: Word; 
  i: integer; s: shortstring; d: double); 
begin 
  if idx < long then chgOne(idx, i, s, d) 
  else fehler(1); 
end; 
 
function TMyObject.getOne(idx: Word): TTest; 
begin 
  if idx < long then result := FArr[idx] else fehler(1); 
end; 
 
(* 
procedure TMyObject.takeOne(idx: word; var t: TTest); 
begin 
  if idx < long then t := FArr[idx] else fehler(1); 
end; 
*) 
 
// -------------------------------------------------- 
 
var mo: TMyObject; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  mo := TMyObject.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  mo.free; 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
var hlp: TTest; 
begin 
  mo.addElements(748, 'Delphi', 14.08); 
  mo.addElements(33333, 'TEST', 14.08); 
  mo.addElements(241048, 'DBR', 12.34); 
  mo.addElements(728901, 'Nix', 1.667); 
  showmessage(mo.readOne[2].s); 
  if not mo.deleteOne[1] then 
    raise exception.create('Fehler beim löschen'); 
//mo.takeOne(2, hlp); 
  hlp := mo.readOne[2]; 
  showmessage(hlp.s); 
  mo.changeOne(2, hlp.i, 'Gewechselt', hlp.d); 
  showmessage(mo.readOne[2].s); 
  mo.insertElements(2, 7, '###', 8.6); 
  showmessage(mo.readOne[2].s); 
  showmessage(inttostr(mo.count)); 
  mo.deleteAll; 
  showmessage(inttostr(mo.count)); 
end; 



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke