// 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;
|