Dynamische Arrays auch unter Delphi 3

[delphifan2004]

Hallo!

Hier der Quelltext, der dynamische Arrays auch unter Delphi 3 realisiert.

Delphi-Quellcode:

unit DynArray;

interface

type
  __P_Dymamic_Array__ = ^__T_Dynamic_Array__;
  __T_Dynamic_Array__ = array[0..0] of byte;

type
  TDynamicArray = class(TObject) //Abstrakter Vorfahre für die eigentlichen
  protected                      //dynamischen Arrays
    FItems: __P_Dymamic_Array__;
    FSize: LongInt;              //Größe der Feldelemente
    FCount: LongInt;             //Anzahl der Feldelemente
    FDims: LongInt;              //Anzah der Dimensionen
  public
    constructor Create(withSize: LongInt); virtual;
    //Weil in Delphi 3 SetLength als reine Stringroutine implementiert ist
    //wird hier eine neue SetLength - Routine definiert
    procedure SetLength(sizes: array of LongInt); virtual; abstract;
    procedure Free;
    property Count: LongInt read FCount write FCount;  //Anzahl Elemente
    property Dims: LongInt read FDims write FDims;
    property Size: Longint read FSize write FSize;     //Größe eines Elementes
  end;

  TDynamicByteArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): Byte;
    procedure setItems(Index: Integer; value: Byte);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: Byte read getItems write setItems; default;
  end;

  TDynamicShortIntArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): ShortInt;
    procedure setItems(Index: Integer; value: ShortInt);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: ShortInt read getItems write setItems; default;
  end;

  TDynamicSmallIntArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): SmallInt;
    procedure setItems(Index: Integer; value: SmallInt);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: SmallInt read getItems write setItems; default;
  end;

  TDynamicWordArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): Word;
    procedure setItems(Index: Integer; value: Word);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: word read getItems write setItems; default;
  end;

  TDynamicIntegerArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): Integer;
    procedure setItems(Index: Integer; value: Integer);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: Integer read getItems write setItems; default;
  end;

  TDynamicLongIntArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): LongInt;
    procedure setItems(Index: Integer; value: LongInt);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: LongInt read getItems write setItems; default;
  end;

  TDynamicPointerArray = class(TDynamicArray)
  private
    function getItems(Index: Integer): Pointer;
    procedure setItems(Index: Integer; value: Pointer);
  public
    constructor Create(withSize: LongInt); override;
    procedure SetLength(sizes: array of LongInt); override;
    property Items[Index: Integer]: Pointer read getItems write setItems; default;
  end;

//Die originale gleichnamige Prozedur ist in der Unit System definiert
//Diese hier überschreibt jene, um mit dynamischen Arrays hantieren zu können
//Die Syntax unterscheidet sich etwas von der originalen.


   EinDynamischesArray := TDynamicWordArray.Create(sizeof(word));
   SetLength(EinDynamischesArray,[12,3,5]);
                                   | | |
                                   | | |_____
                                   | |_______   Die Dimensionen des Arrays 
                                   |_________   
                                    
Oder die SetLength Methode der jeweiligen Array Klasse verwenden.

procedure SetLength(var theArray; sizes: array of LongInt);

implementation


procedure SetLength(var theArray; sizes: array of LongInt);
var 
  _Array: TDynamicArray absolute theArray;
  cbSize: LongInt;
begin
  with _Array do
  begin
    for i:=Low(sizes) to High(sizes) do
    begin
      cbSize := cbSize * sizes[i];
      Inc(FDims);
    end;
    FCount := cbSize;
    ReAllocMem(FItems, FCount * Size);
  end;
end;

constructor TDynamicArray.Create(withSize: LongInt);
begin
  Inherited Create;
  FSize := withSize;
  FCount := 0;
  FDims := 0;
  FItems := nil;
end;

procedure TDynamicArray.Free;
begin
  ReAllocMem(FItems, 0);
  FItems := nil;
  inherited Free;
end;
{
procedure TDynamicArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;
}
//---------------------- TDynamicByteArray ----------------------------------------

function TDynamicByteArray.getItems(Index: Integer): Byte;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicByteArray.setItems(Index: Integer; value: Byte);
var 
  temp: Byte;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicByteArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicByteArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;

//----------------------- TDynamicShortIntArray ------------------------------------

function TDynamicShortIntArray.getItems(Index: Integer): ShortInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicShortIntArray.setItems(Index: Integer; value: ShortInt);
var temp: ShortInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicShortIntArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicShortIntArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;

//-------------- TDynamicSmallIntArray --------------------------

function TDynamicSmallIntArray.getItems(Index: Integer): SmallInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicSmallIntArray.setItems(Index: Integer; value: SmallInt);
var 
  temp: SmallInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicSmallIntArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicSmallIntArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
  //Hier RunTimeError 103 nach ReAllocMem
  //Speichergröße prüfen
end;

//------------------- TDynamicWordArray -------------------------------

function TDynamicWordArray.getItems(Index: Integer): Word;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicWordArray.setItems(Index: Integer; value: Word);
var 
  temp: Word;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicWordArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicWordArray.SetLength(sizes: array of LongInt);
var i: LongInt; cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;

//---------------------- TDynamicIntegerArray ------------------------------

function TDynamicIntegerArray.getItems(Index: Integer): Integer;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicIntegerArray.setItems(Index: Integer; value: Integer);
var 
  temp: Integer;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicIntegerArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicIntegerArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;

//------------------- TDynamicLongIntArray ------------------------------------

function TDynamicLongIntArray.getItems(Index: Integer): LongInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move (FItems^[Index], Result, FSize);
end;

procedure TDynamicLongIntArray.setItems(Index: Integer; value: LongInt);
var 
  temp: LongInt;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicLongIntArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicLongIntArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;

//-------------------- TDynamicPointerArray -----------------------------------

function TDynamicPointerArray.getItems(Index: Integer): Pointer;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems, Result, sizeof(Pointer));
end;

procedure TDynamicPointerArray.setItems(Index: Integer; value: Pointer);
var 
  temp: Pointer;
begin
  if (Index<0) and (Index>FCount-1) then ; //raise EIndexError.Create;
  move(FItems^[Index], temp, FSize);
  if value <> temp then move(value, FItems^[Index], FSize);
end;

constructor TDynamicPointerArray.Create(withSize: LongInt);
begin
  inherited Create(withSize);
end;

procedure TDynamicPointerArray.SetLength(sizes: array of LongInt);
var 
  i: LongInt; 
  cSize: LongInt;
begin
  cSize := 1;
  for i:=Low(sizes) to High(sizes) do
  begin
    cSize := cSize * sizes[i];
    Inc(FDims);
  end;
  FCount := cSize;
  ReAllocMem(FItems, FCount * FSize);
end;


end.

Delphifan2004

Sprint hatte zusätzlich noch folgenden Quelltext als Alternativen Vorschlag, der von der Codelänge her kürzer ist:

Delphi-Quellcode:

type
  TDynIntegerArray = array[0..0] of Integer;
  PDynIntegerArray = ^TDynIntegerArray;

{...}

function SetDynArrayLength(var ADynIntegerArray: PDynIntegerArray; NewLength, OldLength: Integer): Integer;
var
  NewArray: PDynIntegerArray;
begin

  Result := NewLength;
  if Assigned(ADynIntegerArray) then
  begin
    if NewLength = 0 then
    begin
      FreeMem(ADynIntegerArray);
      Result := 0;
    end else begin
      NewArray := AllocMem(NewLength * SizeOf(Integer));
      if NewLength > OldLength then
        Move(ADynIntegerArray^, NewArray^, OldLength * SizeOf(Integer))
      else
        Move(ADynIntegerArray^, NewArray^, NewLength * SizeOf(Integer));
      FreeMem(ADynIntegerArray);
      ADynIntegerArray := NewArray;
    end;
  end else
    ADynIntegerArray := AllocMem(NewLength * SizeOf(Integer));
end;

{...}

procedure TForm1.Button1Click(Sender: TObject);
var
  MyDynArray: PDynIntegerArray;
  ArryLen: Integer;
  I: Integer;
begin

  // lokale Variablen initialisieren
  MyDynArray := nil;
  I := 0;

  // dynamisches Array anlegen
  ArryLen := SetDynArrayLength(MyDynArray, 1, 0);

  // Werte setzen
  MyDynArray^[I] := 10;

  // Array vergrößern
  ArryLen := SetDynArrayLength(MyDynArray, 2, ArryLen);

  // Werte setzen
  I := 1;
  MyDynArray^[I] := 20;

  // Werte lesen
  for I := 0 to ArryLen - 1 do
    ShowMessage(IntToStr(MyDynArray^[I]));

  // dynamischen Array löschen
  SetDynArrayLength(MyDynArray, 0, 0);

end;

[edit=Admin]Code in Delphi-Tags gesetzt. Künftig bitte selber machen. ;-) Mfg, Daniel[/edit]
[edit=Chakotay1308]Code von Sprint ergänzt. Mfg, Chakotay1308[/edit]
[edit=Matze]Code formatiert. Mfg, Matze[/edit]