Dynamisches Array als Klasse

[delphifan2004]

Hallo,

Hier habe ich eine Dynamic-Array Klasse erstellt, inspiriert durch meine Veröffentlichung vor längerer Zeit hier in der DP unter dem Titel "Dynamische Arrays auch unter Delphi 3" Damals hatte ich für jeden Arraytyp eine separate Klasse erstellt. Heute ist nur noch eine einzige Klasse davon übrig geblieben als eindimensionales Array. Alle anderen Klassentypen habe ich entfernt. Die vorliegende Klasse TGenericDynArray kann Integer-Typen und Pointer speichern. Mit dem Pointer sollte es möglich sein, auch kompliziertere Datenstrukturen in einem solchen Array zu speichern. Leider finde ich den damaligen Thread nicht mehr, weshalb ich nun einen neuen eröffne. Außerdem weiß ich von Lazarus, das dort dynamische Arrays auch als Klasse(n) definiert sind.

Ich hatte zuerst auch an mehrdimensionale Arrays gedacht, daher auch die auf mehrdimensionale Arrays ausgelegte SetLength() Methode. Da jedoch in heutigen Delphi- und Lazarus Versionen dynamische Arrays beliebiger Dimensionalität eh Standard sind, belasse ich es nun bei dem eindimensionalen Array.

Hier nun die Unit:

Delphi-Quellcode:

unit DynArray;

interface

uses
  Sysutils, Classes;

type
  PByte = ^Byte;
  PShortInt = ^ShortInt;
  PSmallInt = ^SmallInt;
  PWord     = ^Word;
  PInteger  = ^Integer;
  PLongint  = ^Longint;

  //Workaround für 1 Dimensionales Array
  TElementsType = (
    etByte, etShortInt, etSmallInt, etWord, etInteger, etLongint, etPointer
  );

  TGenericDynArray = class(TObject)
  private
    FCount: Longint;
    FDims: Longint;
    FSize: Longint;
    //FItem: Longint;
    FType: TElementsType;
    FArray: TList;
    FVector: TStringList;
    function GetItems(Index: Integer): Longint;
    function GetItemP(Index: Integer): Pointer;
    function GetItemType: TElementsType;
    procedure SetItems(Index: Integer; value: Longint);
    procedure SetItemP(Index: Integer; value: Pointer);
  protected
    constructor Create; //Für spätere Verwendung
  public
    //Dieser Constructor instantiiert das Array Objekt
    constructor CreateArray(Elements: Integer; ElType: TElementsType);
    destructor Destroy; override;
    property Count: Longint read FCount;                   //Anzahl Elemente -> gesamtes Array
    property Dims: Longint read FDims;                     //Anzahl Dimensionen
    property Size: Longint read FSize;                     //Größe eines Elementes
    //die Array Elemente
    property Items[Index: Integer]: Longint read GetItems write SetItems; default; //passt dann auf alle Typen
    //Wenn Pointer, dann passt dieser Item besser
    //Aber der LOngint Item wandelt Longint intern in Pointer
    property ItemP[Index: Integer]: Pointer read GetItemP write SetItemP;
    //Hier kann der Datentyp der Elemente gelesen werden
    //Festgelegt wird er im Konstruktor mit dem 2. Parameter
    property ItemType: TElementsType read GetItemType;
    procedure SetLength(ElCount: Longint);
  end;

  T1DimArray = TGenericDynArray;           //Fügt sich besser in die Namenskonvention ein



function NewByte(b: Byte): PByte;
function NewShortint(si: ShortInt): PShortInt;
function NewSmallInt(si: SmallInt): PSmallInt;
function NewWord(w: Word): PWord;
function NewInteger(i: Integer): PInteger;
function NewLongint(i: Longint): PLongint;

procedure DisposeShortint(var P: PShortint);
procedure DisposeByte(var P: PByte);
procedure DisposeSmallint(var P: PSmallint);
procedure DisposeWord(var P: PWord);
procedure DisposeInteger(var P: PInteger);
procedure DisposeLongint(var P: PLongint);

procedure InitArray(var A: TList; n: Integer; eltype: TElementsType);
procedure CutArray(var A: TList; n: Integer);

implementation

{ für Dimensionsänderungen während der Laufzeit konzipiert                    }
{ kann natürlich überall benutzt werden, wo man diese Funktionalität braucht  }
{ Das Array selber ist mit TList realisiert und behält deshalb die Daten, die }
 
procedure InitArray(var A: TList; n: Integer; eltype: TElementsType);
begin
  while A.Count < n do
   case eltype of
    etByte     : A.Add(NewByte(0));
    etShortint : A.Add(NewShortint(0));
    etSmallint : A.Add(NewSmallint(0));
    etWord     : A.Add(NewWord(0));
    etInteger  : A.Add(NewInteger(0));
    etLongint  : A.Add(NewLongint(0));
    etPointer  : A.Add(nil);
   end;
end;
 
{ für Dimensionsänderungen während der Laufzeit konzipiert                    }
{ Das Array selber ist mit TList realisiert und behält deshalb die Daten, die }
{ nicht abgeschnitten werden, automatisch                                     }
 
procedure CutArray(var A: TList; n: Integer);
begin
  while n < A.Count do A.Delete(A.Count-1);
end;

function NewByte(b: Byte): PByte;
var P: PByte;
begin
  GetMem(P, Sizeof(b));
  P^ := b;
  Result := P;
end;

function NewShortint(si: ShortInt): PShortInt;
var P: PShortint;
begin
  GetMem(P, Sizeof(si));
  P^ := si;
  Result := P;
end;

function NewSmallInt(si: SmallInt): PSmallInt;
var P: PSmallint;
begin
  GetMem(P, Sizeof(si));
  P^:= si;
  Result := P;
end;

function NewWord(w: Word): PWord;
var P: PWord;
begin
  GetMem(P, Sizeof(w));
  P^:= w;
  Result := P;
end;

function NewInteger(i: Integer): PInteger;
var P: PInteger;
begin
  GetMem(P , Sizeof(i));
  P^:= i;
  Result := P;
end;

function NewLongint(i: Longint): PLongint;
var P: PLongint;
begin
  GetMem(P , Sizeof(i));
  P^:= i;
  Result := P;
end;


procedure DisposeShortint(var P: PShortint);
begin
  freemem(P, Sizeof(Shortint));
end;

procedure DisposeByte(var P: PByte);
begin
  freemem(P, Sizeof(Byte));
end;

procedure DisposeSmallint(var P: PSmallint);
begin
  freemem(P, Sizeof(SmallInt));
end;

procedure DisposeWord(var P: PWord);
begin
  freemem(P, Sizeof(Word));
end;

procedure DisposeInteger(var P: PInteger);
begin
  freemem(P, Sizeof(Integer));
end;

procedure DisposeLongint(var P: PLongint);
begin
  freemem(P, Sizeof(Longint));
end;


{ TGenericDynArray }

function TGenericDynArray.GetItems(Index: Integer): Longint;
begin
Result:=0;
  case FType of
    etByte     : Result := Byte(FArray.Items[Index]^) and $ff;
    etShortInt : Result := Shortint(FArray.Items[Index]^) and $ff;
    etSmallInt : Result := Smallint(FArray.Items[Index]^) and $ffff;
    etWord     : Result := Word(FArray.Items[Index]^) and $ffff;
    etInteger  : Result := Integer(FArray.Items[Index]^);
    etLongint  : Result := LongInt(FArray.Items[Index]^);
    etPointer  : Result := Longint(FArray.Items[Index]);
  end;
end;

function TGenericDynArray.GetItemP(Index: Integer): Pointer;
begin
result:=nil;
  if FType = etPointer then Result := FArray.Items[Index];
end;

function TGenericDynArray.GetItemType: TElementsType;
begin
  Result := FType;
end;

procedure TGenericDynArray.SetItems(Index: Integer; value: Longint);
var
  b: Byte;
begin
  case FType of
    etByte:     begin b := value and $ff; FArray.Items[Index] := NewByte(b); end;
    etShortInt: begin FArray.Items[Index] := NewShortint(value and $ff); end;
    etSmallInt: begin FArray.Items[Index] := NewSmallInt(value and $ffff); end;
    etWord:     begin FArray.Items[Index] := NewWord(value and $ffff); end;
    etInteger:  FArray.Items[Index] := NewInteger(value);
    etLongint:  FArray.Items[Index] := NewLongint(value);
    etPointer:  FArray.Items[Index] := Pointer(value);
  end;
end;

procedure TGenericDynArray.SetItemP(Index: Integer; value: Pointer);
begin
  SetItems(Index, Longint(value));
end;

constructor TGenericDynArray.Create; //für zukünftige Verwendung
begin                                //nicht zum Instanziieren
  inherited Create;
  FArray := TList.Create;
end;

constructor TGenericDynArray.CreateArray(Elements: Integer; ElType: TElementsType);
var i: Integer; P: Pointer;
begin
p:=nil;
  inherited Create;
  FArray := TList.Create;
  for i := 0 to Elements-1 do
  case ElType of
    etByte    : begin FArray.Add(NewByte(0));     FSize := Sizeof(Byte); end;
    etShortInt: begin FArray.Add(NewShortint(0)); FSize := Sizeof(Shortint); end;
    etSmallInt: begin FArray.Add(NewSmallInt(0)); FSize := Sizeof(Smallint); end;
    etWord    : begin FArray.Add(NewWord(0));     FSize := Sizeof(Word); end;
    etInteger : begin FArray.Add(NewInteger(0));  FSize := Sizeof(Integer); end;
    etLongint : begin FArray.Add(NewLongint(0));  FSize := Sizeof(Longint); end;
    etPointer : begin FArray.Add(P);              FSize := Sizeof(Pointer); end;
  end;
  FCount := FArray.Count;
  FDims := 1;
end;

destructor TGenericDynArray.Destroy;
begin
  FArray.Free;
  inherited Destroy;
end;

procedure TGenericDynArray.SetLength(ElCount: Longint);
var
  delta,ix,switch: Integer; Dims: array[0..1] of Longint;
begin
  Dims[0] := ElCount;                      //weil vorher Dims: array of Longint, statt ElCount
  if High(Dims)<2 then                     //Hier wurde die Anzahl aktueller Dimensionen geprüft
  begin                                    //wer mag, kann auf mehrdimensionale Arrays erweitern
    ix := 0;                               //wie ursprünglich vorgesehen, doch aus technischen 
    delta := Dims[0]-FArray.Count;         //Gründen nicht weiter verfolgt.
    if delta < 0 then switch := -1 else    //Differenz zwichen neuer und alter Anzahl Array-Elemente
    if delta > 0 then switch := +1 else
    switch := 0;                           //um übersichtlicheren Code zu erhalten
    case switch of
     -1: if Dims[0]>=0 then while ix > delta do  { oder while FArray.Count > delta }
         begin                             //oder CutArray(FArray, Dims[0]);
           FArray.Delete(FArray.Count-1);
           dec(ix);
         end;
      0: ; //Keine Aktion
     +1: while FArray.Count < Dims[0] do   //oder InitArray(FArray, Dims[0], FType);
         begin
           case FType of                   //wenn neue Länge (Elementanzahl) größer als vorherige
            etByte: FArray.Add(NewByte(0));//dann neue Elemente dazu und mit NULL initialisieren
            etShortint: FArray.Add(NewShortint(0));
            etSmallint: FArray.Add(NewSmallint(0));
            etInteger : FArray.Add(NewInteger (0));
            etLongint : FArray.Add(NewLongint (0));
            etPointer : FArray.Add(nil);
           end;    { von case Ftype }
         end;    { von case +1 -> while do begin }
    end; { von case }
  end; { von if High(Dims) }
FCount := FArray.Count;
end;


end.

Ihr dürft diese Unit per copy & paste in Eure Projekte zu jedem beliebigen Zweck übernehmen.

Soeben hat mir der User "Delphi Laie" den Link zu jenem Thread wieder beschafft. Leider kann ich dort nichts mehr korrigieren. Ich will jedoch den Link zu jenem Thread wenigstens hier setzen, damit die anderen Überlegungen von eventuellen Interessenten auch gefunden werden.

http://www.delphipraxis.net/38721-dy...elphi-3-a.html

Schließlich sind dynamische Arrays unter Lazarus auch als Klassen(n) implementiert.