Массивы
Динамические массивы
Очень простой пример…
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.