Идёт загрузка страницы...

htp://aptem.net.ru





Массив в 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.
[000025]