SHARE
TWEET

lab10

bogdanpashtet Dec 5th, 2019 (edited) 120 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program lab10;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   Windows,
  7.   SysUtils;
  8.  
  9. const
  10.   n_max=10;
  11.  
  12. type
  13.   mat=array[1..n_max] of integer;
  14.  
  15. procedure rus; {русификация}
  16.   begin
  17.     setconsolecp(1251);
  18.     setconsoleoutputcp(1251);
  19.   end;
  20.  
  21. procedure check_files(var dat,rez: textfile); {проверка файлов}
  22.   begin
  23.     if (paramcount = 0) then
  24.       begin
  25.         writeln('К ярлыку не привязаны файлы.');
  26.         readln;
  27.         halt
  28.       end;
  29.     assignfile(dat,paramstr(1));
  30.     assignfile(rez,paramstr(2));
  31.  
  32.     try
  33.       Reset(dat);
  34.     except
  35.       writeln('Ошибка при окрытии входного файла');
  36.       readln;
  37.       halt
  38.       end;
  39.  
  40.     try
  41.       Rewrite(rez);
  42.     except
  43.       writeln('Ошибка при создании или открытии выходного файла');
  44.       close(dat);
  45.       readln;
  46.       halt
  47.       end;
  48.   end;
  49.  
  50. procedure close_pr (var dat,rez:textfile); {выход из программы}
  51.     begin
  52.         close(dat);
  53.         close(rez);
  54.         writeln('...');
  55.         readln;
  56.     end;
  57.  
  58. procedure check_n_u(var dat,rez:textfile; var n,u:shortint); {ввод и проверка n и u}
  59.   begin
  60.     try
  61.       readln(dat,n);
  62.     except
  63.       writeln('Ошибка при считывании n.');
  64.       close_pr(dat,rez);
  65.       halt
  66.       end;
  67.  
  68.     try
  69.       readln(dat,u);
  70.     except
  71.       writeln('Ошибка при считывании U.');
  72.     end;
  73.  
  74.     if (n<1) or (n>n_max) then
  75.       begin
  76.         writeln('Некорректное значение n.');
  77.         close_pr(dat,rez);
  78.         halt
  79.         end;
  80.   end;
  81.  
  82. procedure input_a(var dat,rez:textfile; var a:mat; n:shortint); {ввод массива и проверка его элементов}
  83.   var
  84.     i:shortint;
  85.     flag_a:boolean;
  86.   begin
  87.     i:=0;
  88.     flag_a:=true;
  89.     while (i<n) and (flag_a=true) do
  90.       begin
  91.         inc(i);
  92.         try
  93.           read(dat,a[i]);
  94.         except
  95.           writeln('Ошибка при чтении элемента A[',i,'].');
  96.           flag_a:=false;
  97.           end;
  98.         if (abs(a[i])>10) and (flag_a=true) then
  99.           begin
  100.             writeln('Элемент a[',i,'] имеет недопустимое значение.');
  101.             flag_a:=false;
  102.           end;
  103.       end;
  104.     if (flag_a=false) then
  105.       begin
  106.         close_pr(dat,rez);
  107.         halt
  108.       end;
  109.   end;
  110.  
  111. procedure find_first_positive_element(const a:mat; const n:shortint;  out k:shortint; out flag:boolean); {поиск первого положительного элемента}
  112.   var
  113.     i:shortint;
  114.   begin
  115.     i:=0;
  116.     flag:=true;
  117.     while (i<n) and (flag=true) do
  118.       begin
  119.         inc(i);
  120.         if (a[i]>0) then
  121.           begin
  122.             k:=i;
  123.             flag:=false;
  124.           end;
  125.       end;
  126.   end;
  127.  
  128. procedure quest(var dat,rez:textfile; var a:mat; var n,u,k,m,count:shortint); {поиск максимума}
  129.   var
  130.     i:integer;
  131.   begin
  132.     i:=k;
  133.     m:=-11;
  134.     count:=0;
  135.     while (i<n) do
  136.       begin
  137.         inc(i);
  138.         if (a[i]<u) then
  139.           begin
  140.             inc(count);
  141.             if (a[i]>m) then
  142.               begin
  143.                 m:=a[i];
  144.               end;
  145.           end;
  146.       end;
  147.   end;
  148.  
  149. procedure output(const a:mat; var rez:textfile; var n,u,k,m:shortint); {вывод}
  150.   var
  151.     i:shortint;
  152.   begin
  153.     writeln(rez,'Лабораторная работа №10.');
  154.     writeln(rez);
  155.     writeln(rez,'Длинна массива: ',n);
  156.     writeln(rez);
  157.     writeln(rez,'Значение переменной U: ',u);
  158.     writeln(rez);
  159.     writeln(rez,'Массив A:');
  160.     writeln(rez);
  161.     for i:=1 to n do
  162.          write(rez,a[i],' ');
  163.     writeln(rez);
  164.     writeln(rez);
  165.   end;
  166.  
  167.   var
  168.   dat,rez:textfile;
  169.   n,u,k,m,count:shortint;
  170.   a:mat;
  171.   flag:boolean;
  172.  
  173. begin
  174.   rus;
  175.   check_files(dat,rez);
  176.   check_n_u(dat,rez,n,u);
  177.   input_a(dat,rez,a,n);
  178.   find_first_positive_element(a,n,k,flag);
  179.   output(a,rez,n,u,k,m);
  180.   if (flag=true) then
  181.     writeln(rez,'Все элементы массива меньше нуля.')
  182.   else
  183.     begin
  184.       quest(dat,rez,a,n,u,k,m,count);
  185.       if count=0 then
  186.         writeln(rez,'Не существует элементов таких, что они одновременно больше положительного элемента и меньше U.')
  187.       else
  188.         writeln(rez,'Максимальный элемент: ',m);
  189.     end;
  190.   close_pr(dat,rez);
  191. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top