Составление программы для поиска прямых, параллельных оси X, и вычисления наибольшего расстояния между прямой и осью, страница 4

 InFile:FileName;  (* Имя входного файла *)

 ResFile:FileName;  (* Имя выходного файла *)

 F1:text;  (* Файловая переменная для входного файла *)

 F2:text;  (* Файловая переменная для выходного файла *)

 i, j : integer;  (* Рабочие переменные *)

 i1, i2 : integer;

 Ch:char;  (* Символ для ввода *)

Procedure POISK( N:Ind; ABC:ArrCoef; E:real; var K:integer;

              var NomPr:ArrNom; var R:Vector );

(*    Подпрограмма  поиска прямых, параллельных оси X,    *)

(*      и наибольшего расстояния между прямой и осью    *)

(*     Входные данные     *)

(* N   :integer; - Количество исходных прямых *)

(* ABC :ArrCoef; - Множество троек коэффициентов A, B, C  *)

(*  *)

(*  *)

(*                            *)

(*     Выходные данные     *)

(* K     :integer; - Счетчик прямых, параллельных оси X  *)

(* NomPr :ArrNom;  - Пары порядковых (в массиве ABC) номеров *)

(*                    прямых, параллельных оси X *)

(* R     :Vector   - Вектор расстояний между прямой и осью X *)

(*                                        *)

 Var

  Prisnak1:real;  (* Признак параллельности *)

  Prisnak2:real;

  i1,i2:Ind;  (* Рабочие переменные *)

 begin

  (* Установка начальных значений *)

  K:=0;

  (* Проверка параллельности *)

  for i1:=1 to N do (* Номер первой прямой i1   *)

    begin

    Prisnak1:=abs(ABC[i1,1]);

    Prisnak2:=abs(ABC[i1,2]);

      if (Prisnak1=0) and (Prisnak2>0)   (*  Проверка условия параллельности  *)

       then

         (*Две прямые параллельны*)

      begin

      K:=K+1;

         (*Вычисление расстояний между прямыми*)

      R[K]:=abs(ABC[i1,3]/ABC[i1,2]);

         (*Запись номеров параллельных прямых*)

      NomPr[K,1]:=i1;

      NomPr[K,2]:=i2;

      end{if}

   end{for_i2};

  end  {POISK};

Function Nmax(Vec:Vector; Kol:integer):integer;

(*  Подпрограмма определения номера наибольшего

        элемента в одномерном массиве   *)

 Var

  rab:real;    (*    Рабочие   *)

  i:integer;   (*   переменные  *)

 begin

 (*  Установка начальных значений  *)

 rab:=Vec[1];

 Nmax:=1;

 (*  Начало цикла сравнивания элементов  *)

 for i:=1 to Kol do

  begin

   if rab<Vec[i]

    then

    (* Замена наибольшего элемента  *)

     begin

      rab:=Vec[i];

      Nmax:=i

     end(*if*)

  end(*for*)

 end;(*Nmax*)

(*----------Основной модуль программы-----------*)

Begin

 ClrScr;

 WriteLn('Нажмите любую клавишу для старта...');

 Ch:=ReadKey;

 ClrScr;

(*   Подготовка к чтению файла исходных данных   *)

 Writeln('Введите имя файла исходных данных');

 Readln(InFile);

 Assign(F1,'d:\tpascal\infile');

 Reset(F1);

(*   Формированеи имени и подготовка файла результатов   *)

 ResFile:='';

 i:=1;

 while(InFile[i]<>'.') and

      (i<=Length(InFile)) do

  begin

   ResFile:=ResFile+InFile[i];

   i:=i+1

  end; (*while*)

 Assign(F2,'d:\tpascal\resfile');

 Rewrite(F2);

(*    Ввод и проверка исходных данных    *)

 Readln(F1, N);

 if (N>1) and (N<=KolPrMax)

  then

   begin

    Readln(F1, E);

     if(E>0)

      then

       begin

       (* Ввод коэффициентов прямых *)

      for i:=1 to N do

       for j:=1 to 3 do

        read(F1, ABC[i,j]);

      (* Обращение к подпрограмме POISK*)

      POISK(N, ABC, E, K, NomPr, R);

      if K<>0

       then

        (*  Среди прямых есть К параллельных  *)

        begin

         (*  Определение номера наибольшего расстояния  *)

         i:=Nmax(R,K);

         Rmax:=R[i];

         imax1:=NomPr[i,1]

        end{if};

(*   ВЫВОД РЕЗУЛЬТАТОВ   *)

Writeln(F2,'');

Writeln(F2,'     ИСХОДНЫЕ ДАННЫЕ ');

Writeln(F2,'');