AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Object-Pascal / Delphi-Language Delphi Dynamische Arrays auch unter Delphi 3

Dynamische Arrays auch unter Delphi 3

Ein Thema von delphifan2004 · begonnen am 23. Jan 2005
Antwort Antwort
delphifan2004

Registriert seit: 26. Nov 2004
Ort: Dresden
162 Beiträge
 
Delphi 7 Personal
 
#1

Dynamische Arrays auch unter Delphi 3

  Alt 23. Jan 2005, 12:31
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]
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:35 Uhr.
Powered by vBulletin® Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2020 by Daniel R. Wolf