ARRAYS

  1. Dynamic arrays[NEW]
  2. Array in Delphi

Dynamic arrays[NEW]

From: m.a.vaughan@larc.nasa.gov (Mark Vaughan)

here's a very simple example... 

Const
  MaxBooleans = (High(Cardinal) - $F) div sizeof(boolean);

Type
  TBoolArray = array[1..MaxBooleans] of boolean;
  PBoolArray = ^TBoolArray;

Var
  B : PBoolArray;
  N : integer;

BEGIN
  N := 63579;
{= allocate an arbitrary array size.. =}
  GetMem(B, N*sizeof(boolean));
{= do something with it... =}
  B^[3477] := FALSE;
{= restore the memory to the heap =}
{$IFDEF VER80}
  FreeMem(B, N*sizeof(boolean));
{$ELSE}
  FreeMem(B);
{$ENDIF}
END.

Array in Delphi

Solution 1

From: luribe@slip.net (Luis C. Uribe)

Here are some functions that you can use to handle 2-dim arrays, they can be extended to more dimensions easily. SetV and GetV are made to store and retrieve values from an array of type VArray that you declare as you want. For example:

type
      VArray : Array[1..1] of double;
var
      X : ^VArray;
     NR, NC : Longint;

begin
     NR := 10000;
     NC := 100;
     if AllocArray(pointer(X), N*Sizeof(VArray)) then exit;
     SetV(X^, NC, 2000, 5, 3.27);    { X[2000,5] := 3.27 }
end;

function AllocArray(var V : pointer; const N : longint) : Boolean;
begin        {allocate memory for array V of size N}
     try
        GetMem(V, N);
     except
        ShowMessage('ERROR allocating memory. Size:' + IntToStr(N));
        Result := True;
        exit;
     end;
     FillChar(V^, N, 0);  {in case Long strings involved, need to 0}
     Result := False;
end;

procedure SetV(var X : Varray;const N,ir,ic : LongInt;const value :
double);
begin    {store in 2-dim array X of size ? x N : X[ir,ic] := value}
      X[N*(ir-1) + ic] := value;
end;

function GetV(const X : Varray; const N, ir,ic : Longint) : double;
begin         {returns value X[ir,ic] for 2-dim array with N columns}
      Result := X[N*(ir-1) + ic];
end;

Solution 2

From: Lord of Darkness <j.biddiscombe@rl.ac.uk>

the simplest way is create the array dynamically

Myarray := GetMem(rows * cols * sizeof(byte,word,single,double etc)

do a fetch_num function like

function fetch_num(r,c:integer) : single;

result := pointer + row + col*rows

and then instead of myarray[2,3]

do myarray.fetch_num(2,3)

wrap it all up in an object and you're laughing. I've done a multidimensional (up to 8) dynamic complex array class which is based on this principle and it works a treat.

Solution 3

From: m.a.vaughan@larc.nasa.gov (Mark Vaughan)

here's one way to create simple one-dimensional and two-dimensional dynamic array classes.

(*
 --
 -- unit to create two very simple dynamic array classes
 --     TDynaArray   :  a one dimensional array
 --     TDynaMatrix  :  a two dimensional dynamic array
 --
*)

unit DynArray;

INTERFACE

uses
  SysUtils;

Type
  TDynArrayBaseType  =  double;

Const
  vMaxElements  =  (High(Cardinal) - $f) div sizeof(TDynArrayBaseType);
                       {= guarantees the largest possible array =}


Type
  TDynArrayNDX     =  1..vMaxElements;
  TArrayElements   =  array[TDynArrayNDX] of TDynArrayBaseType;
        {= largest array of TDynArrayBaseType we can declare =}
  PArrayElements   =  ^TArrayElements;
        {= pointer to the array =}

  EDynArrayRangeError  =  CLASS(ERangeError);

  TDynArray  =  CLASS
    Private
      fDimension : TDynArrayNDX;
      fMemAllocated  :  word;
      Function  GetElement(N : TDynArrayNDX) : TDynArrayBaseType;
      Procedure SetElement(N : TDynArrayNDX; const NewValue : TDynArrayBaseType);
    Protected
      Elements : PArrayElements;
    Public
      Constructor Create(NumElements : TDynArrayNDX);
      Destructor Destroy; override;
      Procedure Resize(NewDimension : TDynArrayNDX); virtual;
      Property dimension : TDynArrayNDX
          read fDimension;
      Property Element[N : TDynArrayNDX] : TDynArrayBaseType
          read  GetElement
          write SetElement;
          default;
    END;

Const
  vMaxMatrixColumns  =  65520 div sizeof(TDynArray);
    {= build the matrix class using an array of TDynArray objects =}

Type
  TMatrixNDX  =  1..vMaxMatrixColumns;
  TMatrixElements  =  array[TMatrixNDX] of TDynArray;
    {= each column of the matrix will be a dynamic array =}
  PMatrixElements  =  ^TMatrixElements;
    {= a pointer to an array of pointers... =}

  TDynaMatrix  =  CLASS
    Private
      fRows          : TDynArrayNDX;
      fColumns       : TMatrixNDX;
      fMemAllocated  : longint;
      Function  GetElement( row : TDynArrayNDX;
                            column : TMatrixNDX) : TDynArrayBaseType;
      Procedure SetElement( row : TDynArrayNDX;
                            column : TMatrixNDX;
                            const NewValue : TDynArrayBaseType);
    Protected
      mtxElements : PMatrixElements;
    Public
      Constructor Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);
      Destructor Destroy; override;
      Property rows : TDynArrayNDX
          read fRows;
      Property columns : TMatrixNDX
          read fColumns;
      Property Element[row : TDynArrayNDX; column : TMatrixNDX] : TDynArrayBaseType
          read  GetElement
          write SetElement;
          default;
    END;

IMPLEMENTATION

(*
  --
  --  TDynArray methods
  --
*)
Constructor TDynArray.Create(NumElements : TDynArrayNDX);
  BEGIN   {==TDynArray.Create==}
    inherited Create;
    fDimension := NumElements;
    GetMem( Elements, fDimension*sizeof(TDynArrayBaseType) );
    fMemAllocated := fDimension*sizeof(TDynArrayBaseType);
    FillChar( Elements^, fMemAllocated, 0 );
  END;    {==TDynArray.Create==}

Destructor TDynArray.Destroy;
  BEGIN   {==TDynArray.Destroy==}
    FreeMem( Elements, fMemAllocated );
    inherited Destroy;
  END;    {==TDynArray.Destroy==}

Procedure TDynArray.Resize(NewDimension : TDynArrayNDX);
  BEGIN   {TDynArray.Resize==}
    if (NewDimension < 1) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [NewDimension]);
    Elements := ReAllocMem(Elements, fMemAllocated, NewDimension*sizeof(TDynArrayBaseType));
    fDimension := NewDimension;
    fMemAllocated := fDimension*sizeof(TDynArrayBaseType);
  END;    {TDynArray.Resize==}

Function  TDynArray.GetElement(N : TDynArrayNDX) : TDynArrayBaseType;
  BEGIN   {==TDynArray.GetElement==}
    if (N < 1) OR (N > fDimension) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [N]);
    result := Elements^[N];
  END;    {==TDynArray.GetElement==}

Procedure TDynArray.SetElement(N : TDynArrayNDX; const NewValue : TDynArrayBaseType);
  BEGIN   {==TDynArray.SetElement==}
    if (N < 1) OR (N > fDimension) then
      raise EDynArrayRangeError.CreateFMT('Index out of range : %d', [N]);
    Elements^[N] := NewValue;
  END;    {==TDynArray.SetElement==}

(*
  --
  --  TDynaMatrix methods
  --
*)
Constructor TDynaMatrix.Create(NumRows : TDynArrayNDX; NumColumns : TMatrixNDX);
  Var     col  :  TMatrixNDX;
  BEGIN   {==TDynaMatrix.Create==}
    inherited Create;
    fRows := NumRows;
    fColumns := NumColumns;
  {= acquire memory for the array of pointers (i.e., the array of TDynArrays) =}
    GetMem( mtxElements, fColumns*sizeof(TDynArray) );
    fMemAllocated := fColumns*sizeof(TDynArray);
  {= now acquire memory for each column of the matrix =}
    for col := 1 to fColumns do
      BEGIN
        mtxElements^[col] := TDynArray.Create(fRows);
        inc(fMemAllocated, mtxElements^[col].fMemAllocated);
      END;
  END;    {==TDynaMatrix.Create==}

Destructor  TDynaMatrix.Destroy;
  Var     col  :  TMatrixNDX;
  BEGIN   {==TDynaMatrix.Destroy;==}
    for col := fColumns downto 1 do
      BEGIN
        dec(fMemAllocated, mtxElements^[col].fMemAllocated);
        mtxElements^[col].Free;
      END;
    FreeMem( mtxElements, fMemAllocated );
    inherited Destroy;
  END;    {==TDynaMatrix.Destroy;==}

Function  TDynaMatrix.GetElement( row : TDynArrayNDX;
                                  column : TMatrixNDX) : TDynArrayBaseType;
  BEGIN   {==TDynaMatrix.GetElement==}
    if (row < 1) OR (row > fRows) then
      raise EDynArrayRangeError.CreateFMT('Row index out of range : %d', [row]);
    if (column < 1) OR (column > fColumns) then
      raise EDynArrayRangeError.CreateFMT('Column index out of range : %d', [column]);
    result := mtxElements^[column].Elements^[row];
  END;    {==TDynaMatrix.GetElement==}

Procedure TDynaMatrix.SetElement( row : TDynArrayNDX;
                                  column : TMatrixNDX;
                                  const NewValue : TDynArrayBaseType);
  BEGIN   {==TDynaMatrix.SetElement==}
    if (row < 1) OR (row > fRows) then
      raise EDynArrayRangeError.CreateFMT('Row index out of range : %d', [row]);
    if (column < 1) OR (column > fColumns) then
      raise EDynArrayRangeError.CreateFMT('Column index out of range : %d', [column]);
    mtxElements^[column].Elements^[row] := NewValue;
  END;    {==TDynaMatrix.SetElement==}


END.
----Test program for the DynArray unit---- 
uses DynArray, WinCRT;

Const
  NumRows  :  integer = 7;
  NumCols  :  integer = 5;

Var
  M  :  TDynaMatrix;
  row, col  :  integer;
BEGIN
  M := TDynaMatrix.Create(NumRows, NumCols);
  for row := 1 to M.Rows do
    for col := 1 to M.Columns do
      M[row, col] := row + col/10;
  writeln('Matrix');
  for row := 1 to M.Rows do
    BEGIN
      for col := 1 to M.Columns do
        write(M[row, col]:5:1);
      writeln;
    END;
  writeln;
  writeln('Transpose');
  for col := 1 to M.Columns do
    BEGIN
      for row := 1 to M.Rows do
        write(M[row, col]:5:1);
      writeln;
    END;
  M.Free;
END.
Please email me and tell me if you liked this page.