code

program project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
    System.SysUtils;
type
    ToWorkArr = array of array of Integer;

function check(min,max:Integer; msg,error, integererror:String):Integer;
var
    IsCorrect:Boolean;
   numb:Integer;
begin
    IsCorrect:= false;
   Writeln(msg);
   repeat
    try
        readln(numb);
        if((numb > min) and (numb < max)) then
            IsCorrect:= true
        else
            Writeln(error);
      except
        Writeln(integererror);
      end;
   until (IsCorrect);
check:=numb;
end;


procedure FillArrKeyboard(var MyArr: ToWorkArr; LengthOfArr: Integer);

const
MinInt=0;
MaxInt=100;

var
i, j: Integer;
CorrectFilling: Boolean;

begin
    for i := 0 to LengthOfArr do
        for j := 0 to LengthOfArr do
            begin
                WriteLn('Please enter elements of array (values from ', MinInt, ' to ', MaxInt, ').');
                repeat
                    CorrectFilling := False;
               Write('A[', i, ', ', j, '] = ');
               try
                        ReadLn(MyArr[i, j]);
                        CorrectFilling := True;
                    except
                    WriteLn('Error! Please enter a numerical value with a range from ', MinInt, ' to ', MaxInt, '.');
                    end;
                until (CorrectFilling);
            end;
end;
var
    ArrA, ArrB : ToWorkArr;
   n, i, j, a : Integer;


begin
   n:=check(2,5,'Vvedite kolvo strok i stolbcov kvadratnoi matrici','Error','integererror');
   n:=n-1;
   FillArrKeyboard(ArrA,n);
   //SetLength(ArrA, n, n);
   //SetLength(ArrB,n, n);

   //for i:=0 to n do
   //   for j:=0 to n do
   //   begin
   //       Write('A[',i,',',j,']=');
   //      Readln(ArrA[i,j]);
   //   end;
   for i:=0 to n do
   begin
    for j:=0 to n do
        Write('  ', ArrA[i,j]);
      writeln;
   end;
   for i := 0 to (n div 2) do
    for j := 0 to n do
            ArrB[((n div 2 + 1) + i),j] := ArrA[i,j];   //Это первый
   //for i := 0 to n do
     // for j := 0 to n do
          //  ArrB[n-i,n-j] := ArrA[i,j];
   a := 0;
   for i := (n div 2 + 1) to n do
   begin
    for j := n downto 0 do
            ArrB[a,n-j] := ArrA[i,j];
      inc(a);
   end;
   Writeln('#10#13Finish');
   for i:=0 to n do
   begin
    for j:=0 to n do
        Write('  ', ArrB[i,j]);
      writeln;
   end;
   readln;
end.