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

{$R-}
{ Отключаем проверку компилятором границ массива. Необходимо для дин. массивов в Турбо Паскале }
Type
  MyType={здесь описываешь тип элемента массива, скажем} Word;
Type
  MyArray=Array[1..1] of MyType;  {Описываем массив всего из 1 элемента}
  MyArrayPtr=^MyArray;
Var
  DynamicArray: MyArrayPtr;       {Это указатель на наш динамически массив}
  Count,                          {Это вводимый размер массива}
  I,Size: Word;
Begin
  {Вводим размер массива}  
  Write('Число элементов массива: ');
  ReadLn(Count);
 
  { выделяем под него память:  Count x РазмерТипа }  
  Size:=Count*SizeOf(MyType);
  GetMem(DynamicArray,Size);
 
  {заполняем наш массив значениями}
  For I:=1 to Count do DynamicArray^[I]:=I;
 
  For I:=1 to Count do
    Write(DynamicArray^[I]:4);  
 
  {освобождаем зарезервированную память для массива}
  FreeMem(DynamicArray,Size)
End.

{ (C) volvo877 }
{$R-}
Type
  MyType = Word;
Type
  PMyVector = ^MyVector;
  { "Строка" динамической матрицы }
  MyVector = Array[1 .. 1] of MyType;
 
  MyArrayPtr = ^MyArray;
  { Сама матрица - представляется как массив указателей на "строки" }
  MyArray = Array[1 .. 1] of PMyVector;
 
Var
  DynamicArray: MyArrayPtr;   { Указатель на матрицу }
  Count,
  I,J,Size: Word;
Begin
  Write('Число элементов массива: ');
  ReadLn(Count);
 
  { Выделяем память под указатели на "строки" }
  GetMem(DynamicArray, Count * SizeOf(PMyVector));
  { И для каждой "строки" - выделяем память для хранения данных } 
  For i := 1 To Count Do 
    GetMem(DynamicArray^[i], Count*SizeOf(MyType));
 
  For I:=1 to Count do { Lines }
    For J:=1 to Count do { Columns }
      { Немного изменяется способ обращения к элементу матрицы }
      DynamicArray^[I]^[J]:=I*J;
 
  For I:=1 to Count do
  begin
     WriteLn;
     For J:=1 to Count do
         Write(DynamicArray^[I]^[J]:4);
  end;
 
  { Освобождаем память в обратном порядке: }
  { Сначала - удаляем все "строки" }
  For i := 1 To Count Do
    FreeMem(DynamicArray^[i], Count*SizeOf(MyType));
  { А теперь и указатели на них ... }
  FreeMem(DynamicArray, Count * SizeOf(PMyVector));
End.

{ Программа работает при включенном контроле границ }
{$R+}
program Test;
 
type
  T = Word;
 
  { Строка матрицы }
  MyVector  = Array [1 .. MaxInt div SizeOf(T)] of T;
  PMyVector = ^MyVector;
 
  { Матрица }
  MyMatrix  = Array[1 .. MaxInt div SizeOf(PMyVector)] of PMyVector;
  PMyMatrix = ^MyMatrix;
 
  { Куб - третье измерение }
  MyCube  = Array[1 .. MaxInt div SizeOf(PMyMatrix)] of PMyMatrix;
  PMyCube = ^MyCube;
 
{
  Создаем динамический "кубик" из Depth матриц, каждая из которых
  имеет Height строк и Width столбцов.
 
  Указатель на выделенную память возвращается как результат функции.
}
function CreateCubeArray(Width, Height, Depth: Integer): PMyCube;
var
  Cube: PMyCube;
  i, j: Integer;
begin
  GetMem(Cube, Depth * SizeOf(PMyMatrix));
 
  for i := 1 to Depth do
  begin
    GetMem(Cube^[i], Height * SizeOf(PMyVector));
 
    for j := 1 to Height do
    begin
      GetMem(Cube^[i]^[j], Width * SizeOf(T));
    end;
  end;
 
  CreateCubeArray := Cube;
end;
 
{
  Освобождаем ранее выделенную под "кубик" память.
  Внимательнее с порядком освобождения: сначала - массивы,
  потом - матрицы, и только в самом конце - куб.
}
procedure DisposeCubeArray(var Cube: PMyCube;
          Width, Height, Depth: Integer);
var
  i, j: Integer;
begin
  for i := 1 to Depth do
  begin
    for j := 1 to Height do
    begin
      FreeMem(Cube^[i]^[j], Width * SizeOf(T));
    end;
 
    FreeMem(Cube^[i], Height * SizeOf(PMyVector))
  end;
 
  FreeMem(Cube, Depth * SizeOf(PMyMatrix));
  Cube := nil;
end;
 
{
  В данной процедуре также обратите внимание на правильный порядок
  индексов.
 
  Первый слева индекс ("глубина") должен изменяться в интервале 1 .. Depth
  Второй ("высота") - в интервале 1 .. Height
  Третий ("ширина") - в интервале 1 .. Width
 
  Если вы перепутаете индексы местами - то программа либо вылетит
  с ошибкой (например, разыменование нулевого указателя), если
  текущее значение какого-либо индекса БОЛЬШЕ, чем было задано
  при создании "куба", либо просто будет отображать ваш "кубик"
  неправильно.
}
procedure PrintCubeArray(Arr: PMyCube;
          Width, Height, Depth: Integer);
var
  i, j, k: Integer;
begin
  if Arr <> nil then
  begin
    for i := 1 to Depth do
    begin
      for j := 1 to Height do
      begin
        for k := 1 to Width do Write(Arr^[i]^[j]^[k]:4);
        WriteLn;
      end;
      WriteLn;
    end;
  end
  else WriteLn('<пусто>')
end;
 
const
  cubeWidth  = 3;
  cubeHeight = 2;
  cubeDepth  = 2;
var
  myArray: PMyCube;
  i, j, k: Integer;
begin
  myArray := CreateCubeArray(cubeWidth, cubeHeight, cubeDepth);
 
  for i := 1 to cubeDepth do
    for j := 1 to cubeHeight do
      for k := 1 to cubeWidth do myArray^[i]^[j]^[k] := i*j*k;
 
  PrintCubeArray(myArray, cubeWidth, cubeHeight, cubeDepth);
  DisposeCubeArray(myArray, cubeWidth, cubeHeight, cubeDepth);
end.