Lab 12 unit

unit Unit12;

interface

  const n_max=5;

  type matrix=array[1..n_max,1..n_max] of shortint;

                      {Проверка подключенных файлов}
  procedure check_files(var dat,rez:textfile);

                       {Проверка размерности матрицы}
  procedure check_n(var dat:textfile; out n:shortint; out flag_n:boolean);

                   {Ввод матрицы из файла, файл уже открыт}
  procedure input(var a:matrix; const n:integer; var dat:textfile; out p,e:shortint);

                    {Ввод и проверка элементов матрицы}
  procedure check_a(var dat:textfile; const n:shortint; out a:matrix; out flag_a:boolean);

            {Проверка на наличие элемента, удовлетворяещего условию |a[i,j]|-|P|<E}
  function analysis(const a:matrix; const n,p,e:shortint; out m:shortint):boolean;

                 {Поиск среднего арифметического положительных элементов}
  procedure check_average_positive(var rez:textfile; var a:matrix; const n:shortint; out av:real);

                {Вывод матрицы и переменных в файл, файл уже открыт}
  procedure output_a(const a:matrix; const n,p,e:shortint; out rez:textfile);

                  {Закрытие файлов}
  procedure close_pr(var dat,rez:textfile);


implementation

  procedure check_files; //проверка входного и выходного файла
      begin
      if (paramcount = 0) then
      begin
        writeln ('К ярлыку не привязаны файлы.');
        writeln('...');
        readln;
        halt
      end;
      assignfile(dat,paramstr(1));
      assignfile(rez,paramstr(2));

    try //try-except
      Reset(dat);
    except
      writeln('Ошибка при окрытии входного файла.');
      writeln('...');
      readln;
      halt
      end;

    try
      Rewrite(rez);
    except
      writeln('Ошибка при создании или открытии выходного файла.');
      close(dat);
      writeln('...');
      readln;
      halt
      end;
    end;

  procedure check_n; //проверка размерности матрицы
    begin
       flag_n:=true;
       try
         read(dat,n);
       except
         writeln('Ошибка при чтении размерности матрицы A.');
         flag_n:=false;
       end;
       if ((n<1) or (n>n_max)) and (flag_n=true) then
          begin
             writeln('Размерность матрицы A выходит за диапазон условленных значений.');
             flag_n:=false;
          end;
       writeln('N = ',flag_n,' after check_n');
    end;

  procedure input;
  var
     i,j:shortint;
  begin
     readln(dat,P);
     readln(dat,E);
     for i := 1 to n do
         begin
            for j := 1 to n do
                begin
                   read(dat,a[i,j]);
                end;
         end;

  end;

  procedure check_a; //ввод и проверка элементов матрицы
    var
      i,j:byte;
    begin
       i:=0;
       flag_a:=true;
       while (i<n) and (flag_a=true) do
             begin
                inc(i);
                j:=0;
                while (j<n) and (flag_a=true) do
                      begin
                         inc(j);
                         if (abs(a[i,j])>100) and (flag_a=true) then
                            begin
                               writeln('A[',i,';',j,'] выходит за диапазон условленных значений.');
                               flag_a:=false;
                            end;
                      end;
             end;
    writeln('A = ',flag_a,' after check_a');
    end;

  function analysis(const a:matrix; const n,p,e:shortint; out m:shortint):boolean; //проверка на наличие
    var
      i,j:byte;
      flag:boolean;
    begin
       flag:=true;
       for i := 1 to n do
           begin
              for j := 1 to n do
                  begin
                     if ((abs(abs(a[i,j])-abs(P)))<E) then
                        begin
                           flag:=false;
                           m:=a[i,j];
                        end;
                  end
           end;
       analysis:=flag;
    end;

  procedure check_average_positive; //поиск среднего арифметического положительных элементов каждой строки
    var
      i,j:byte;
      sum:shortint;
    begin
       sum:=0;
       for i := 1 to n do
           begin
              for j := 1 to n do
                  begin
                     if (a[i,j])>0 then
                        sum:=sum+a[i,j];
                  end;
              av:=sum/n;
              writeln(rez, 'Среднее арифметическое положительных элементов ',i,' строки', ' = ',av:4:3,'  ');
              sum:=0;
           end;
    end;

  procedure output_a; //вывод матрицы
    var
       i,j:byte;
    begin
       writeln(rez,'-----------------');
       for i:=1 to n do
           begin
              for j:=1 to n do
                  write(rez,a[i,j],' ');
                  writeln(rez);
           end;
       writeln(rez,'-----------------');
       writeln(rez,'P = ',P);
       writeln(rez,'E = ',E);
       writeln(rez,'-----------------');
    end;

procedure close_pr; //выход из программы
    begin
        close(dat);
        close(rez);
        writeln('...');
        readln;
        halt
    end;
end.