program Z21;

uses
  crt;   {Вывод на экран}


type
  matr  = array [1..6, 1..6] of integer;
  matr2 = array[1..6, 1..6] of integer;
  {--------Описание переменных------}
var
  a:     matr;    {Исходная матрица}
  tabl:  matr2;   {Новая матрица}
  Error: integer; {переменная для хранения кода ошибки операции ввода/вывода}
  i, j:  byte;    {индексы}
  n, k:  byte;    {количество строк и столбцов}
  ch:    char;    {переменные для хранения кода символа нажатой клавиши}
  for_0, for_1, for_2: char;
  nam_e: string; {имя исходной матрицы}
label L1;
Label L2;
Label L3;      {Описание меток}

  {---------------Процедура ввода имен, количества строк и столбцов матрицы---------------}

procedure Mv(var n:byte; var k: byte;var nam_e:string); {функция ввода матрицы}
    var
        error: integer;
    begin
     Gotoxy(2, 3);
     textcolor(green);
     Write('Введите имя матрицы: ');
     Readln(nam_e);
     Clrscr;
     Gotoxy(4, 4);
     textcolor(lightblue);
     Writeln('Максимально допустимая размерность матрицы - 6х6 элементов');
     gotoxy(4, 6);
     textcolor(lightcyan);
     Write('Введите количество строк матрицы  ', nam_e, ':  ');
    repeat   {Начало цикла с постусловием}


      {---------------Ввод размерности матрицы---------------}

{$i-}
      ;
      Readln(n);
      error := IOresult;
{$i+}
      ;
      if (n < 1) or (n > 6) or (Error <> 0) then
      begin  {2}
        Textattr := lightred;
        Writeln('Ошибка! Количество строк матрицы - от 1 до 6. Повторите ввод!');
      end; {2}
    until (n >= 1) and (n <= 6) and (Error = 0); {Конец цикла с постусловием}
    begin {3}
      repeat
        Gotoxy(4, 8);
        Textattr := cyan;
        Write('Введите количество столбцов матрицы ', nam_e, ':  ');
{$i-}
        ;
        Readln(k);
        error := IOresult;
{$i+}
        ;
        if (k < 1) or (k > 6) or (Error <> 0) then
        begin  {4}
          Textattr := lightred;
          Writeln('Ошибка! Количество столбцов матрицы - от 1 до 6. Повторите ввод!');
        end;  {4}
      until (k >= 1) and (k <= 6) and (Error = 0);
      end;
      end;


  {---------------Процедура, создающая новую матрицу из положительных элементов---------------}
  procedure Ml(var TABL: Matr2);
  var
    i, j: integer;
  begin{1}
    gotoxy(3, 4);
    textattr := yellow;
    writeln('Положительные элементы: ');

    for i := 1 to n do
    begin    {2}

      for j := 1 to k do
      begin    {3}
        if a[i, j] > 0 then
        begin  {4}
          TABL[i, j] := A[i, j];
          Write(tabl[i, j]: 4);

          Write('  ');

          writeln;
        end;  {4}
      end;   {3}
    end; {2}
  end; {1}



  {---------------Процедура, создающая новую матрицу из отрицательных элементов---------------}
  procedure Md(var TABL: Matr2);
  var
    i, j: integer;
  begin    {1}
    gotoxy(3, 4);
    writeln('Отрицательные элементы: ');

    for i := 1 to n do
    begin     {2}

      for j := 1 to k do
      begin  {3}
        if a[i, j] < 0 then
        begin  {4}
          TABL[i, j] := A[i, j];
          Write(tabl[i, j]: 4);

          Write('   ');

          writeln;
        end;  {4}
      end;  {3}
    end;  {2}
  end;   {1}




  {---------------Процедура, обеспечивающая вывод на экран исходной и новой матриц---------------}
  procedure Raspl(for_2: char);
  var
    I, j: byte;
  label
    L1;
  begin  {1}
    clrscr;
    gotoxy(25, 1);
    Textattr := lightgreen;
    writeln('Результаты обработки:');
    Textattr := yellow;
    gotoxy(1, 3);
    writeln('Исходная матрица: ');
    writeln;
    Textattr := lightcyan;
    Gotoxy(1, 5);
    for i := 1 to n do
    begin  {2}
      for j := 1 to k do
        Write(A[i, j]: 5, ' ');
      writeln;
    end; {2}


    case for_2 of {3}
      'S', 's':
      begin {4}
       window(40, 3, 80, 15);
        gotoxy(n + 38, 3); {Справа от исходной}
        Textattr := yellow;
        writeln('Новая матрица: ');
        writeln;

        Textattr := lightmagenta;
        for i := 1 to n do
        begin  {5}
          for j := 1 to k do
            Write(TABL[i, j]: 5, ' ');
          writeln;
        end;  {5}
      end;    {4}


      'L', 'l':
      begin   {6}

        Textattr := yellow; {Под исходной}
        Gotoxy(1, k + 8);
        writeln('Новая матрица: ');

        writeln;
        gotoxy(1, k + 10);
        Textattr := lightmagenta;
        for i := 1 to n do
        begin   {7}
          for j := 1 to k do
            Write(TABL[i, j]: 5, ' ');
          writeln;
        end;   {7}
      end;  {6}
    end; {3}
  end; {1}
begin {Начало программы}  {1}

   Textattr:=lightcyan;
       Gotoxy (12,2);
     Writeln ('В данной программе вы можете :');
     Textattr:=lightgreen;
       Gotoxy (6, 4);
     Writeln ('- задать любое имя для исходной матрицы');
        Gotoxy (6, 5);
     Writeln ('- задать число строк,столбцов матрицы');
         Gotoxy (6, 6);
     Writeln ('- выбрать из каких элементов будет сформирована новая матрица: ');
       Gotoxy (6,7);
     Writeln ('из положительных/отрицательных элементов соответственно ');
       Gotoxy (6,8);
     Writeln ('- выбрать вариант расположения матриц на экране из двух предлагаемых.');
   gotoxy(20, 15);
  textcolor(yellow);
  writeln('Нажмите любую клавишу,чтобы продолжить.');
  L1:
    ch := readkey;
  L3: clrscr;
 Mv(n,k,nam_e);
      clrscr;
      gotoxy(6, 2);
      Textattr := lightred;
      Writeln('Внимание!');
      gotoxy(3, 4);
      writeln('Матрица должна содержать только целые числа от -1000 до 1000');
      textattr := white;
      gotoxy(6, 6);
      writeln('Вводите элементы матрицы'); {Ввод элементов матрицы}
      for i := 1 to n do
      begin            {4}
        for j := 1 to k do
        begin             {5}
          repeat
            Write(nam_e, '[', i, ',', j, '] : ');
{$i-}
            ;
            readln(a[i, j]);
            error := IOresult;
{$i+}
            ;
            if (a[i, j] < -10000) or (a[i, j] > 10000) or (Error <> 0) then
            begin                    {6}
              Textattr := lightred;
              Writeln('Ошибка!Повторите ввод!');
            end;                        {6}




          until (a[i, j] <= 10000) or (a[i, j] >= -10000) or (Error = 0);

        end;                       {5}
        writeln;
                                  {4}
    end;                              {3}
    {2}

    {3}


    {1}

    Window (1,1,80,25);
    clrscr;
     Gotoxy (6,6);
     Textattr:= Lightmagenta;
     Writeln ('Ваша матрица:');
     Window (18,9,80,25);
     Textattr:=magenta;
      For i:=1 to n do
        Begin
         For j:=1 to k do
          Begin
           Write (A[i,j]:5, ' ');
          End;
         Writeln;
        End;
        Window (1,1,80,25);
     Gotoxy (6, 15);
     Textattr:= yellow;
     Writeln ('Для продолжения нажмите "R"');
     Gotoxy (6,16);
     Writeln ('А чтобы ввести матрицу снова - "U" ');

     Case readkey of
     'R': goto L2;
     'r': goto L2;
     'U': goto L3;
     'u': Goto L3;
     End;
     Window (1,1,80,25);
      writeln;
      Textattr:= white;
     L2:

     clrscr;


    gotoxy(3,3);
  textattr := lightgreen;
  writeln('Какие элементы матрицы вывести?');
   gotoxy(3,4);
    textattr := yellow;
  writeln('М-положительные, Q-отрицательные ');

  case readkey of {7}
    'M', 'm': Ml(TABL);
    'Q', 'q': Md(TABL);
  end; {7}
  clrscr;
  textattr := lightgreen;
    gotoxy(3,3);
  writeln('В каком виде вывести матрицы?');
    gotoxy(3,4);
  textattr :=lightcyan;
  writeln('Новая матрица справа от исходной-S,под исходной-L');
  readln(for_2);
  Raspl(for_2);
  window(20, 24, 80, 25);

  textattr := white;
  Write('Хотите начать заново?Y-Да, N-нет');
  window(1, 1, 80, 25);
  Write;
  case readkey of {8}
    #89, #121: goto L1;
    #78, #110: exit;
  end;           {8}
  readln;
end.  {1}