М

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)) and not Odd(Numb) then
            IsCorrect:= True
        else
            Writeln(Error);
      except
        Writeln(IntegerError);
      end;
   until (IsCorrect);
Check:=Numb;
end;


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

const
   MinInt = - MaxInt - 1;

var
   i, j: Integer;
   CorrectFilling: Boolean;

begin
   Writeln('Please, enter a numerical value with a range from ', MinInt, ' to ', MaxInt, '):');
   for i := 0 to LengthOfArr do
      for j := 0 to LengthOfArr do
      begin

         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;
   for i:=0 to LengthOfArr do
   begin
    for j:=0 to LengthOfArr do
        Write('  ', MyArr[i,j] : 3);
      Writeln;
   end;
end;

procedure Swap(var MyFirstArr: ToWorkArr; MySecondArr: ToWorkArr; LengthOfArr: Integer);

var
   i, a, j, HalfOfLength, NextLine: Integer;

begin
   HalfOfLength:= LengthOfArr div 2;
   NextLine:= LengthOfArr div 2 + 1;
   for i := 0 to HalfOfLength do
    for j := 0 to LengthOfArr do
            MySecondArr[((NextLine) + i),j] := MyFirstArr[i,j];
   a := 0;
   for i := (NextLine) to LengthOfArr do
   begin
    for j := LengthOfArr downto 0 do
            MySecondArr[a, LengthOfArr - j] := MyFirstArr[i, j];
      inc(a);
   end;
end;
 procedure GetOutConclusion(MyArr: ToWorkArr; LengthOfArr: Integer);
 var
   i,j:Integer;
 begin
   Writeln('Result of matrix swap: ');
   for i := 0 to LengthOfArr do
   begin
    for j := 0 to LengthOfArr do
        Write('  ', MyArr[i,j] : 3);
      Writeln;
   end;
 end;

procedure Main();
var
    ArrA, ArrB : ToWorkArr;
   n, i, j, a : Integer;

begin
   Writeln('Theme: There are a real square matrix of order 2n. It`s necessary to obtain a new matrix, where the sub-matrices are interchanged');
   n := Check(1, 7, 'Enter the number of rows and columns of the square matrix', 'The number must be bigger than 2 but less then 6, the number must be even','The number must be an integer!');
   SetLength(ArrA, n, n);
   SetLength(ArrB,n, n);
   n := n - 1;
   FillArrKeyboard(ArrA,n);
   Swap(ArrA,ArrB,n);
   GetOutConclusion(ArrB,n);
   Readln;
end;

begin
   Main();
end.