Советы по Delphi. Версия 1.0.6 - [13]

--
*)
unit DynArray;
INTERFACE
uses SysUtils;
Type TDynArrayBaseType = double;
Const vMaxElements  =  (High(Cardinal) – $f) div sizeof(TDynArrayBaseType);
{= гарантирует максимально возможный массив =}
Type
 TDynArrayNDX     =  1..vMaxElements;
 TArrayElements   =  array[TDynArrayNDX] of TDynArrayBaseType;
 {= самый большой массив TDynArrayBaseType, который мы может объявить =}
 PArrayElements   =  ^TArrayElements;
 {= указатель на массив =}

 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);
 {= построение матрицы класса с использованием массива объектов TDynArray =}

Type
 TMatrixNDX  =  1..vMaxMatrixColumns;
 TMatrixElements  =  array[TMatrixNDX] of TDynArray;
 {= каждая колонка матрицы будет динамическим массивом =}
 PMatrixElements  =  ^TMatrixElements;
 {= указатель на массив указателей… =}
 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
 --
*)
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('Индекс вышел за границы диапазона : %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('Индекс вышел за границы диапазона : %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('Индекс вышел за границы диапазона : %d', [N]);
 Elements^[N]:= NewValue;
END;    {==TDynArray.SetElement==}

(*
 --
 --  методы TDynaMatrix
 --
*)
Constructor TDynaMatrix.Create(NumRows: TDynArrayNDX; NumColumns: TMatrixNDX);
Var col :  TMatrixNDX;
BEGIN   {==TDynaMatrix.Create==}
 inherited Create;
 fRows:= NumRows;
 fColumns:= NumColumns;
 {= выделение памяти для массива указателей (т.е. для массива TDynArrays) =}
 GetMem(mtxElements, fColumns*sizeof(TDynArray));
 fMemAllocated:= fColumns*sizeof(TDynArray);
 {= теперь выделяем память для каждого столбца матрицы =}
 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('Индекс строки вышел за границы диапазона : %d', [row]);
 if (column < 1) OR (column > fColumns) then raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);
 result:= mtxElements^[column].Elements^[row];
END;    {==TDynaMatrix.GetElement==}

Procedure TDynaMatrix.SetElement(row: TDynArrayNDX; column: TMatrixNDX; const NewValue: TDynArrayBaseType);