{ Программа работает при включенном контроле границ }

{$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.

{$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.