Two dimensional dynamic arrays

Re Two dimensional dynamic arrays

In response to
Jonas Eliasson   elias...@arch.kth.se

Phillip Middlemiss  
phill...@tawa.fri.cri   NZ Forest Research Institute

Catherine Rees-Lay  
cathe...@polyhdrn.demon.co.uk  Polyhedron Software

Matt Francomb      
m...@setanta.demon.co.uk    Setanta Software Ltd

To Matt Francomb.  

Thanks for your code.
I have changed it a lot, see below.

You used a Record. I have used a Class.
Is there any advantage in using the record.

Your code looped between 0 and max-1
mine  between 1 and max.

Is there any advantage in leaving semicolons off
lines before end statements.  Is this optional.
An example of your code is:

    begin
      if elements <> Nil then
      begin
        FreeMem( ... )
        Elements := Nil  { ; }
      end { ; }
    end;

I am learning Delphi. If you have any comments or improvements
to this code I would like to hear from you.

The following code needs no changes to run.

program Dynarr;

uses
  SysUtils, WinCrt ;

Type
  tRealArray = Array[0..0] of Real ;
  tRealArrayPtr = ^tRealArray ;

Type
  tRealMatrix = class
    RowMax : integer ;
    ColMax : integer ;
    ElementsPtr : tRealArrayPtr ;
    Constructor Create( kc, kr : integer )  ;
    Destructor  Destroy ; override ;
    Function    GetIndex( kc, kr : integer ) : Integer ;
    Procedure   TestMatrix ( kc, kr : integer ) ;
    Function    NeededMemory : Integer ;
    Procedure   SetValue( kc, kr : integer; aValue : Real );
    Function    GetValue( kc, kr : integer ) : Real ;
  end; { class }

  Constructor tRealMatrix.Create( kc, kr : integer )  ;
  var
    Ptr : Pointer ;
  begin
    inherited Create ;
    ColMax := kc ;
    RowMax := kr ;
    ElementsPtr := Nil ;
    Try
      GetMem( Ptr, NeededMemory );
      ElementsPtr := tRealArrayPtr( Ptr ) ;
    Except
      writeln( 'Error in tRealMatrix.Create ' );
    end; { try }
  end; { proc }

  Destructor tRealMatrix.Destroy  ;
  begin
    if ElementsPtr <> Nil then begin
      FreeMem( Pointer(ElementsPtr), NeededMemory );
      ElementsPtr := Nil ;
    end; { if }
    inherited Destroy ;
  end;

  Procedure tRealMatrix.TestMatrix( kc, kr : integer ) ;
  begin
    if   ( kc < 1 )
      or ( kc > ColMax )
      or ( kr < 1 )
      or ( kr > RowMax )
      or ( ElementsPtr = Nil )
    then begin
      writeln(' Error in tRealMatrix.');
      writeln(' Col =', kc:10, '  Maximum =', ColMax:10 );
      writeln(' Row =', kr:10, '  Maximum =', RowMax:10 );
      if ElementsPtr = Nil then writeln(' tRealMatrix not created.');
      Raise Exception.Create('Error in tRealMatrix.');    
    end;  { if }
  end; { proc }

  Function tRealMatrix.GetIndex( kc, kr : integer ) : Integer ;
  begin
    TestMatrix( kc, kr ) ;  { Could comment TestMatrix out after debugging }
    Result := (kr-1) * ColMax + kc - 1  ;
  end; { fn }

  Procedure tRealMatrix.SetValue( kc, kr : integer; aValue : Real );
  begin
    ElementsPtr^[ GetIndex( kc, kr ) ] := aValue ;
  end; { proc }

  Function tRealMatrix.GetValue( kc, kr : integer ) : Real ;
  begin
    Result := ElementsPtr^[ GetIndex( kc, kr ) ] ;
  end; { proc }

  Function tRealMatrix.NeededMemory : Integer ;
  begin
    Result := ColMax * RowMax * SizeOf(Real) ;
  end; { proc }

var
  aMat : tRealMatrix ;
  nc, nr : integer ;
  ColWidth : integer ;

begin  { main test units }
  Writeln(' testing Real matrix ');
  ColWidth := 7 ;
  DefineFout ;

  Try

    aMat := tRealMatrix.Create( 10, 8 ) ;

    with aMat do
    begin

      writeln(' Set values to zero ');
      for nc := 1 to ColMax do
      for nr := 1 to RowMax do
      SetValue( nc, nr, 0.0 );

      writeln(' Set row 7 to 7.0 ');
      for nc := 1 to ColMax do
      SetValue( nc, 7, 7 );

      writeln(' Show results ');
      for nr := 1 to RowMax do
      begin
        write( nr:ColWidth );
        for nc := 1 to ColMax do Write( GetValue( nc, nr ):ColWidth:0 );
        writeln ;
      end;

      { SetValue(8, 10, 5.0 ); to test an error }

    end; { with aMat }

  Finally
    aMat.Destroy ;
  end;

end.

I am interested in any comments about this code.
Please e-mail them to me as I can miss stuff on the bulletin board.

Andrew Gunner
andr...@netspace.net.au  30/10/95