DYNARR

Top  Previous  Next

(*

--

-- unit to create two very simple dynamic array classes

--     TDynaArray   :  a one dimensional array

--     TDynaMatrix  :  a two dimensional dynamic array

--

*)

 

unit DynArr;

 

INTERFACE

 

uses

SysUtils, WinTypes;

 

Type

TDynArrayBaseType  =  TPoint;

 

Const

vMaxElements  =  (High(Cardinal) - $f) div sizeof(TDynArrayBaseType);

                     {= guarantees the largest possible array =}

 

 

Type

TDynArrayNDX     =  0..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;

    fTentative : integer;     {Tentativ tűrés kör sugara kereséskor}

    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;

    Procedure Add(data:TDynArrayBaseType);

    Procedure Insert(N:TDynArrayNDX;data:TDynArrayBaseType);

    Procedure Delete(N:TDynArrayNDX);

    Function  SourceXY(p:TPoint):longint;

    Property dimension : TDynArrayNDX read fDimension;

    Property Element[N : TDynArrayNDX] : TDynArrayBaseType

        read  GetElement

        write SetElement;

        default;

    Property Tentative : integer read FTentative write FTentative;

  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 );

  FTentative := 4;

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 < 0) 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==}

 

    Procedure TDynArray.Add(data:TDynArrayBaseType);

    begin

      Resize(Dimension+1);

      Elements^[Dimension] := data;

    end;

 

    Procedure TDynArray.Insert(N:TDynArrayNDX;data:TDynArrayBaseType);

    var i: Cardinal;

    begin

      If (N<=fDimension) and (N>-1) then begin

         Resize(Dimension+1);

         For i:=Dimension downto N+1 do Elements^[i] := Elements^[i-1];

         Elements^[N] := data;

      end;

    end;

 

    Procedure TDynArray.Delete(N:TDynArrayNDX);

    var i: Cardinal;

    begin

      If (N<=fDimension) and (N>-1) then begin

         For i:=N+1 to Dimension do Elements^[i-1] := Elements^[i];

         Resize(Dimension-1);

      end;

    end;

 

    {keresés tentativ tűrésel: -1 = nem talált; n = talált elem indexe}

    Function  TDynArray.SourceXY(p:TPoint):longint;

    var i: Cardinal;

    begin

      Result := -1;

      If Dimension>0 then

      For i:=0 to Dimension do begin

          If Abs(p.x - Elements^[i].x) < Tentative then

             If Abs(p.y - Elements^[i].y) < Tentative then

             begin

               Result := i;

               Exit;

             end;

      end;

    end;

 

Function  TDynArray.GetElement(N : TDynArrayNDX) : TDynArrayBaseType;

BEGIN   {==TDynArray.GetElement==}

  if (N < 0) 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 < 0) 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.