Читать онлайн «Советы по Delphi. Версия 1.0.6». Страница 9

BEGIN

 N:= 63579;

 {= получение памяти под динамический массив.. =}

 GetMem(B, N*sizeof(boolean));

 {= работа с массивом… =}

 B^[3477]:= FALSE;

 {= возвращение памяти в кучу =}

 {$IFDEF VER80}

  FreeMem(B, N*sizeof(boolean));

 {$ELSE}

  FreeMem(B);

 {$ENDIF}

END.

Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры SetV и GetV позволяют читать и сохранять элементы массива VArray (его Вы можете объявить как угодно). Например:

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        {распределяем память для массива v размера n}

 try

  GetMem(V, N);

 except

  ShowMessage('ОШИБКА выделения памяти. Размер:' + IntToStr(N));

  Result:= True;

  exit;

 end;

 FillChar(V^, N, 0);  {в случае включения длинных строк заполняем их нулями}

 Result:= False;

end;

procedure SetV(var X: Varray; const N,ir,ic: LongInt;const value: double);

begin    {заполняем элементами двухмерный массив x размером ? 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         {возвращаем величины x[ir,ic] для двухмерного массива шириной n столбцов}

 Result:= X[N*(ir-1) + ic];

end;

Самый простой путь – создать массив динамически

Myarray:= GetMem(rows * cols * sizeof(byte,word,single,double и пр.)

сделайте функцию fetch_num типа

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

result:= pointer + row + col*rows

и затем вместо myarray[2,3] напишите

myarray.fetch_num(2,3)

поместите эти функции в ваш объект и работа с массивами станет пустячным делом. Я экспериментировал с многомерными (вплоть до 8) динамическими сложными массивами и эти функции показали отличный результат.

Вот способ создания одно– и двухмерных динамических массивов:

(*

--

–- модуль для создания двух очень простых классов обработки динамических массивов

--     TDynaArray   :  одномерный массив

--     TDynaMatrix  :  двумерный динамический массив

--

*)

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

BEGIN   {==TDynaMatrix.SetElement==}

 if (row < 1) OR (row > fRows) then raise EDynArrayRangeError.CreateFMT('Индекс строки вышел за границы диапазона : %d', [row]);

 if (column < 1) OR (column > fColumns) then raise EDynArrayRangeError.CreateFMT('Индекс столбца вышел за границы диапазона : %d', [column]);

 mtxElements^[column].Elements^[row]:= NewValue;

END;    {==TDynaMatrix.SetElement==}

END.

-Тестовая программа для модуля DynArray-

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('Матрица');

 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('Перемещение');

 for col:= 1 to M.Columns do BEGIN