Паскаль

Массивы

Динамические массивы

Очень простой пример…

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;

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

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

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

B^[3477]:= FALSE;

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

{$IFDEF VER80}

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

{$ELSE}

FreeMem(B);

{$ENDIF}

END.

Массив в Delphi

Раздел 1

Вот несколько функций для операций с двухмерными массивами. Самый простой путь для создания собственной библиотеки. Процедуры 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;

Раздел 2

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

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) динамическими сложными массивами и эти функции показали отличный результат.

Раздел 3

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

(*

--

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

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

for row:= 1 to M.Rows do write(M[row, col]:5:1);

writeln;

END;

M.Free;

END.

Оглавление