Точки пересечеия двух коник
 

Отношение предназначено для построения точек пересечения двух кривых второго порядка: Коники 1 и Коники 2.

Если тип объекта, указанного в любом из входных параметров, несовместим с типом этого параметра, то при активизированном флажке NIL в выходной параметр заносится NIL-объект


 
Параметры
Типы объектов
Функциональное назначение параметров
Точка 1 Точка Первая точка пересечения коник
Точка 2 Точка Вторая точка пересечения коник
Точка 3 Точка Третья точка пересечения коник
Точка 4
Точка
Четвертая точка пересечения коник
Коника 1
Коника
Первая исходная коника
Коника 2
Коника
Вторая исходная коника
 

Прототип команды: YY Согласование Точка1 Точка2 Точка3 Точка4 ; Коника1 Коника2 .

 
Пример:

Найти точки пересечения двух коник.


1
Точка p10 задана координатами -172 и -1 .
2
Точка p9 задана координатами -83 и 85 .
3
Точка p8 задана координатами -142 и 175 .
4
Точка p7 задана координатами -328 и 155 .
5
Точка p6 задана координатами -231.5 и 109.5 .
6
Точка p5 задана координатами -110 и -151 .
7
Точка p4 задана координатами -21 и -65 .
8
Точка p3 задана координатами 8.5 и 72.5 .
9
Точка p2 задана координатами -266 и 5 .
10
Точка p1 задана координатами -292 и -97 .
11
Коника y2 по точкам p6 , p7 , p8 , p9 , p10 .
12
Коника y1 по точкам p1 , p2 , p3 , p4 , p5 .
13
Точки p11 , p12 , p13 , p14 есть результат пересечения коник y1 и y2 .


 

function EExecYY(in_prm1,in_prm2: TObj;  var out_prm1,out_prm2,out_prm3,out_prm4: TObj; Att_1,Att_2,Att_3,Att_4: TAtt; Sg1,Sg2: integer;  OW1,OW2,OW3,OW4: pointer): boolean;
var
// объявление объектов-переменных
   d1, ksi1, o1, o2, o3, o4, p1, p10, p11, p12, p13, p14, p15, p16, p17, p18, p19, p2, p20,
   p21, p22, p23, p24, p3, p4, p5, p6, p7, p8, p9, x1, x2, x3, x4, x5, y1, y2, pcc,ChislA, ChislB, ChislC, ChislD, ChislE: TObj;
   SpisG3, SpisGA: TNewList;
   Success: boolean;

// объявление величин}
   Chisl1, Chisl2, Chisl3, Chisl4, Chisl5, Chisl6, Chisl7, Chisl8, Chisl9, Chisl10, Chisl11, Chisl12, Chisl13, Chisl14, Chisl15, Chisl16, Chisl17, Chisl18, Chisl19, Chisl20, Chisl21, Chisl22, Chisl23, Chisl24, Chisl25: TOChisl;
const
     Att_p1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p2: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p3: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p4: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p5: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_y1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_d1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p6: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p7: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p8: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p9: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p10: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_y2: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p11: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_o1: TAtt = ( PT:0; LT:0; LV:5; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_o2: TAtt = ( PT:0; LT:0; LV:5; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p12: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p13: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p14: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p15: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p16: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_o3: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_o4: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p17: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p18: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p19: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p20: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_ksi1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_x1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p21: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p22: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p23: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p24: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_x2: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_x3: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_x4: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_x5: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);

begin
// инициализация переменных
   d1:=nil;
   ksi1:=nil;
   o1:=nil;
   o2:=nil;
   o3:=nil;
   o4:=nil;
   p1:=nil;
   p10:=nil;
   p11:=nil;
   p12:=nil;
   p13:=nil;
   p14:=nil;
   p15:=nil;
   p16:=nil;
   p17:=nil;
   p18:=nil;
   p19:=nil;
   p2:=nil;
   p20:=nil;
   p21:=nil;
   p22:=nil;
   p23:=nil;
   p24:=nil;
   p3:=nil;
   p4:=nil;
   p5:=nil;
   p6:=nil;
   p7:=nil;
   p8:=nil;
   p9:=nil;
   x1:=nil;
   x2:=nil;
   x3:=nil;
   x4:=nil;
   x5:=nil;
   y1:=nil;
   y2:=nil;
   pcc:=NIL;
// объявление значений величин
   Chisl1:=TOChisl.Create(MCompl(161.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl2:=TOChisl.Create(MCompl(142.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl3:=TOChisl.Create(MCompl(-37.3,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl4:=TOChisl.Create(MCompl(167.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl5:=TOChisl.Create(MCompl(203.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl6:=TOChisl.Create(MCompl(210.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl7:=TOChisl.Create(MCompl(-183.7,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl8:=TOChisl.Create(MCompl(250.6,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl9:=TOChisl.Create(MCompl(-174.4,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl10:=TOChisl.Create(MCompl(221.9,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl11:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl12:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl13:=TOChisl.Create(MCompl(100,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl14:=TOChisl.Create(MCompl(136,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl15:=TOChisl.Create(MCompl(57,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl16:=TOChisl.Create(MCompl(225,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl17:=TOChisl.Create(MCompl(143,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl18:=TOChisl.Create(MCompl(170.2,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl19:=TOChisl.Create(MCompl(251.3,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl20:=TOChisl.Create(MCompl(-20,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl21:=TOChisl.Create(MCompl(213,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl22:=TOChisl.Create(MCompl(-46,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl23:=TOChisl.Create(MCompl(111,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl24:=TOChisl.Create(MCompl(90,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl25:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);

   (*
   y1:=in_prm1.CreateCopy(NIL);
   y1.OAtt:=att_y1;

   y2:=in_prm2.CreateCopy(NIL);
   y2.OAtt:=att_y2;
*)

// реализация программы

   Result:=TRUE;

   if in_Prm1 is TOKwadr then
   begin
        y1:=in_Prm1.CreateCopy(NIL);
        y1.OAtt:=in_Prm1.OAtt;
   end;

   if in_Prm1 is TODuga then
   begin
        ChislA:=NIL;
        ChislB:=NIL;
        ChislC:=NIL;
        ChislD:=NIL;
        ChislE:=NIL;
        ChislA:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
        ChislB:=TOChisl.Create(MCompl(0.2,0),tc_Constant,NAtt,NIL,c_ord);
        ChislC:=TOChisl.Create(MCompl(0.4,0),tc_Constant,NAtt,NIL,c_ord);
        ChislD:=TOChisl.Create(MCompl(0.6,0),tc_Constant,NAtt,NIL,c_ord);
        ChislE:=TOChisl.Create(MCompl(0.8,0),tc_Constant,NAtt,NIL,c_ord);
        Success:=EExecP9(in_Prm1,ChislA,p1,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm1,ChislB,p2,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm1,ChislC,p3,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm1,ChislD,p4,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm1,ChislE,p5,Att5,1,1,NIL);
        Success:=EExecY0(p1,p2,p3,p4,p5,y1,in_Prm1.OAtt,1,1,1,1,1,NIL);
        MassFree([ChislA,ChislB,ChislC,ChislD,ChislE,p1,p2,p3,p4,p5]);
        p1:=NIL; p2:=NIL; p3:=NIL; p4:=NIL; p5:=NIL;
   end;

 

   //возможно, требуется управление от знаковго флага SG1

   if in_Prm2 is TOKwadr then
   begin
        y2:=in_Prm2.CreateCopy(NIL);
        y2.OAtt:=in_Prm2.OAtt;
   end;
   if in_Prm2 is TODuga then
   begin
        ChislA:=NIL;
        ChislB:=NIL;
        ChislC:=NIL;
        ChislD:=NIL;
        ChislE:=NIL;
        ChislA:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
        ChislB:=TOChisl.Create(MCompl(0.2,0),tc_Constant,NAtt,NIL,c_ord);
        ChislC:=TOChisl.Create(MCompl(0.4,0),tc_Constant,NAtt,NIL,c_ord);
        ChislD:=TOChisl.Create(MCompl(0.6,0),tc_Constant,NAtt,NIL,c_ord);
        ChislE:=TOChisl.Create(MCompl(0.8,0),tc_Constant,NAtt,NIL,c_ord);
        Success:=EExecP9(in_Prm2,ChislA,p1,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm2,ChislB,p2,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm2,ChislC,p3,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm2,ChislD,p4,Att5,1,1,NIL);
        Success:=EExecP9(in_Prm2,ChislE,p5,Att5,1,1,NIL);
        Success:=EExecY0(p1,p2,p3,p4,p5,y2,in_Prm2.OAtt,1,1,1,1,1,NIL);
        MassFree([ChislA,ChislB,ChislC,ChislD,ChislE,p1,p2,p3,p4,p5]);
        p1:=NIL; p2:=NIL; p3:=NIL; p4:=NIL; p5:=NIL;
   end;

   //возможно, требуется управление от знаковго флага SG2
   p1:=NIL; p2:=NIL; p3:=NIL; p4:=NIL; p5:=NIL;

   repeat
      Success:=FALSE;
      if not Assigned(p10) then
         Success:=EExecP0(Chisl1,Chisl2,p10,Att_p10,1,1,NIL) or Success;
      if not Assigned(p9) then
         Success:=EExecP0(Chisl3,Chisl4,p9,Att_p9,1,1,NIL) or Success;
      if not Assigned(p8) then
         Success:=EExecP0(Chisl5,Chisl6,p8,Att_p8,1,1,NIL) or Success;
      if not Assigned(p7) then
         Success:=EExecP0(Chisl7,Chisl8,p7,Att_p7,1,1,NIL) or Success;
      if not Assigned(p6) then
         Success:=EExecP0(Chisl9,Chisl10,p6,Att_p6,1,1,NIL) or Success;
      if not Assigned(d1) then
         Success:=EExecD00(Chisl11,Chisl12,Chisl13,d1,Att_d1,1,1,1,NIL) or Success;
      if not Assigned(p5) then
         Success:=EExecP0(Chisl14,Chisl15,p5,Att_p5,1,1,NIL) or Success;
      if not Assigned(p4) then
         Success:=EExecP0(Chisl16,Chisl17,p4,Att_p4,1,1,NIL) or Success;
      if not Assigned(p3) then
         Success:=EExecP0(Chisl18,Chisl19,p3,Att_p3,1,1,NIL) or Success;
      if not Assigned(p2) then
         Success:=EExecP0(Chisl20,Chisl21,p2,Att_p2,1,1,NIL) or Success;
      if not Assigned(p1) then
         Success:=EExecP0(Chisl22,Chisl23,p1,Att_p1,1,1,NIL) or Success;
      if not Assigned(p16) then
         Success:=EExecPA(d1,p16,Att_p16,1,NIL) or Success;
      if not Assigned(o4) then
         Success:=EExecO1(p16,Chisl24,o4,Att_o4,1,1,NIL) or Success;
      if not Assigned(o3) then
         Success:=EExecO1(p16,Chisl25,o3,Att_o3,1,1,NIL) or Success;
      if not Assigned(o1) and not Assigned(o2) then
      begin
         if in_Prm1 is TOKwadr then
         begin
              Success:=EExecOY(y1,o1,o2,Att_o1,Att_o2,1*Sg1,NIL,NIL) or Success;
         end;
         if in_Prm1 is TODuga then
         begin
              Success:=EExecPA(in_Prm1,pcc,Att5,1,NIL) or Success;
              Success:=EExecO1(pcc,Chisl11,o1,Att5,1,1,NIL) or Success;
              Success:=EExecO1(pcc,Chisl24,o2,Att5,1,1,NIL) or Success;
              MassFree([pcc]);
         end;

      end;
      if not Assigned(p11) then
      begin
         if in_Prm1 is TOKwadr then
         Success:=EExecPA(y1,p11,Att_p11,1*Sg1,NIL) or Success;
         if in_Prm1 is TODuga then
         Success:=EExecPA(in_Prm1,p11,Att_p11,1*Sg1,NIL) or Success;
      end;
      if not Assigned(p19) and not Assigned(p20) then
         Success:=EExecP6(o4,d1,p19,p20,Att_p19,Att_p20,1,1,NIL,NIL) or Success;
      if not Assigned(p17) and not Assigned(p18) then
         Success:=EExecP6(o3,d1,p17,p18,Att_p17,Att_p18,1,1,NIL,NIL) or Success;

         if in_Prm1 is TOKwadr then
      begin
      if not Assigned(p14) and not Assigned(p15) then
         Success:=EExecPG(o2,y1,p14,p15,Att_p14,Att_p15,1,1*Sg1,NIL,NIL) or Success;
      if not Assigned(p12) and not Assigned(p13) then
         Success:=EExecPG(o1,y1,p12,p13,Att_p12,Att_p13,1,1*Sg1,NIL,NIL) or Success;
      end;

         if in_Prm1 is TODuga then
      begin
      if not Assigned(p14) and not Assigned(p15) then
         Success:=EExecP6(o2,in_Prm1,p14,p15,Att_p14,Att_p15,1,1*Sg1,NIL,NIL) or Success;
      if not Assigned(p12) and not Assigned(p13) then
         Success:=EExecP6(o1,in_Prm1,p12,p13,Att_p12,Att_p13,1,1*Sg1,NIL,NIL) or Success;
      end;

      if not Assigned(ksi1) then
         Success:=EExecK0(p12,p14,p13,p15,p17,p20,p18,p19,ksi1,Att_ksi1,1,1,1,1,1,1,1,1,NIL) or Success;
      if not Assigned(x1) then
         Success:=EExecKU(ksi1,y2,x1,Att_x1,1,1*Sg2,NIL) or Success;
      if not Assigned(p21) and not Assigned(p22) and not Assigned(p23) and not Assigned(p24) then
         Success:=EExecYYA(x1,p21,p22,p23,p24,Att_p21,Att_p22,Att_p23,Att_p24,1,NIL,NIL,NIL,NIL) or Success;
      if not Assigned(x2) then
         Success:=EExecKU(ksi1,p22,x2,Att_x2,-1,1,NIL) or Success;
      if not Assigned(x3) then
         Success:=EExecKU(ksi1,p23,x3,Att_x3,-1,1,NIL) or Success;
      if not Assigned(x4) then
         Success:=EExecKU(ksi1,p21,x4,Att_x4,-1,1,NIL) or Success;
      if not Assigned(x5) then
         Success:=EExecKU(ksi1,p24,x5,Att_x5,-1,1,NIL) or Success;
   until not Success;

   out_prm1:=x2.CreateCopy(OW1);
   out_prm1.OAtt:=att_1;

   out_prm2:=x3.CreateCopy(OW2);
   out_prm2.OAtt:=att_2;

   out_prm3:=x4.CreateCopy(OW3);
   out_prm3.OAtt:=att_3;

   out_prm4:=x5.CreateCopy(OW4);
   out_prm4.OAtt:=att_4;

   AddInc(y1,out_prm1);
   AddInc(y1,out_prm2);
   AddInc(y1,out_prm3);
   AddInc(y1,out_prm4);
   AddInc(y2,out_prm1);
   AddInc(y2,out_prm2);
   AddInc(y2,out_prm3);
   AddInc(y2,out_prm4);

 

// освобождение памяти из-под объявленных объектов

       MassFree([d1,ksi1,o1,o2,o3,o4,p1,p10,p11,p12,p13,p14,p15,p16,p17,p18,p19,p2,p20,p21,p22,p23,p24,
    p3,p4,p5,p6,p7,p8,p9,x1,x2,x3,x4,x5,y1,y2,
    Chisl1,Chisl2,Chisl3,Chisl4,Chisl5,Chisl6,Chisl7,Chisl8,Chisl9,Chisl10,Chisl11,Chisl12,Chisl13,Chisl14,
    Chisl15,Chisl16,Chisl17,Chisl18,Chisl19,Chisl20,Chisl21,Chisl22,Chisl23,Chisl24,Chisl25]);
end; { EExecYY }

function EExecYYA(in_prm1: TObj;  var out_prm1,out_prm2,out_prm3,out_prm4: TObj; Att_1,Att_2,Att_3,Att_4: TAtt; Sg1: integer;  OW1,OW2,OW3,OW4: pointer): boolean;
var
    Verify: real;
    AA: Arr5x5;
    BB,X: Arr5;
    Y1,Y2,Y3,Y4,X1,X2,X3,X4: complex;

 

// объявление объектов-переменных
   d1, p1, p2, p3, p4, conica,CX1,CY1,CX2,CY2,CX3,CY3,CX4,CY4: TObj;
   SpisG3, SpisGA: TNewList;
   Success: boolean;

// объявление величин}
   Chisl1, Chisl2, Chisl3, Chisl4, Chisl5, Chisl6, Chisl7, Chisl8, Chisl9, Chisl10, Chisl11: TOChisl;
const
     Att_d1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p1: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p2: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p3: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_p4: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);
     Att_conica: TAtt = ( PT:0; LT:0; LV:0; HT:7; Width:1; Chk:1; Cmp:0; Ilb:0; Comment:NIL; Layers:NIL);

begin
// инициализация переменных
   d1:=nil;
   p1:=nil;
   p2:=nil;
   p3:=nil;
   p4:=nil;
   conica:=nil;
// объявление значений величин
   Chisl9:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl10:=TOChisl.Create(MCompl(0,0),tc_Constant,NAtt,NIL,c_ord);
   Chisl11:=TOChisl.Create(MCompl(100,0),tc_Constant,NAtt,NIL,c_ord);

   conica:=in_prm1.CreateCopy(NIL);
   conica.OAtt:=att_conica;

 

// реализация программы

   Result:=TRUE;
   conica:=in_Prm1.CreateCopy(NIL);
   conica.OAtt:=in_Prm1.OAtt;
   //возможно, требуется управление от знаковго флага SG1

   repeat
         Success:=FALSE;
         if not Assigned(d1) then
         Success:=EExecD00(Chisl9,Chisl10,Chisl11,d1,Att_d1,1,1,1,NIL) or Success;
   until not Success;

 

   with TOKwadr(conica) do
   begin
        AA[1,1]:=X1.Re*X1.Re; AA[1,2]:=X1.Re*Y1.Re; AA[1,3]:=Y1.Re*Y1.Re; AA[1,4]:=X1.Re; AA[1,5]:=Y1.Re; BB[1]:=1;
        AA[2,1]:=X2.Re*X2.Re; AA[2,2]:=X2.Re*Y2.Re; AA[2,3]:=Y2.Re*Y2.Re; AA[2,4]:=X2.Re; AA[2,5]:=Y2.Re; BB[2]:=1;
        AA[3,1]:=X3.Re*X3.Re; AA[3,2]:=X3.Re*Y3.Re; AA[3,3]:=Y3.Re*Y3.Re; AA[3,4]:=X3.Re; AA[3,5]:=Y3.Re; BB[3]:=1;
        AA[4,1]:=X4.Re*X4.Re; AA[4,2]:=X4.Re*Y4.Re; AA[4,3]:=Y4.Re*Y4.Re; AA[4,4]:=X4.Re; AA[4,5]:=Y4.Re; BB[4]:=1;
        AA[5,1]:=X5.Re*X5.Re; AA[5,2]:=X5.Re*Y5.Re; AA[5,3]:=Y5.Re*Y5.Re; AA[5,4]:=X5.Re; AA[5,5]:=Y5.Re; BB[5]:=1;
   end;
   Gauss(AA,BB,X);

   Verify:=1;
   with TOKwadr(conica) do
   Verify:=Verify*0+X[1]*X1.Re*X1.Re+X[2]*X1.Re*Y1.Re+X[3]*Y1.Re*Y1.Re+X[4]*X1.Re+X[5]*Y1.Re-1;

   Vertolet(X,Y1,Y2,Y3,Y4,X1,X2,X3,X4);
   CX1:=TOChisl.Create(X1,tc_Constant,NAtt,NIL,c_ord);
   CY1:=TOChisl.Create(Y1,tc_Constant,NAtt,NIL,c_ord);
   CX2:=TOChisl.Create(X2,tc_Constant,NAtt,NIL,c_ord);
   CY2:=TOChisl.Create(Y2,tc_Constant,NAtt,NIL,c_ord);
   CX3:=TOChisl.Create(X3,tc_Constant,NAtt,NIL,c_ord);
   CY3:=TOChisl.Create(Y3,tc_Constant,NAtt,NIL,c_ord);
   CX4:=TOChisl.Create(X4,tc_Constant,NAtt,NIL,c_ord);
   CY4:=TOChisl.Create(Y4,tc_Constant,NAtt,NIL,c_ord);

   EExecP0(CX1,CY1,p1,Att5,1,1,NIL);
   EExecP0(CX2,CY2,p2,Att5,1,1,NIL);
   EExecP0(CX3,CY3,p3,Att5,1,1,NIL);
   EExecP0(CX4,CY4,p4,Att5,1,1,NIL);

 

   out_prm1:=p3.CreateCopy(OW1);
   out_prm1.OAtt:=att_1;

   out_prm2:=p1.CreateCopy(OW2);
   out_prm2.OAtt:=att_2;

   out_prm3:=p2.CreateCopy(OW3);
   out_prm3.OAtt:=att_3;

   out_prm4:=p4.CreateCopy(OW4);
   out_prm4.OAtt:=att_4;

 

// освобождение памяти из-под объявленных объектов

    MassFree([d1,p1,p2,p3,p4,conica,Chisl9,Chisl10,Chisl11,
    CX1,CY1,CX2,CY2,CX3,CY3,CX4,CY4]);
end; { EExecYYA }

procedure Vertolet(X:Arr5;   var Y1,Y2,Y3,Y4,X1,X2,X3,X4: complex);
var A,B,C,D,E,F,R,M,N,P,Q,S,Verify: real;
    Re1,Re2,Re3,Re4,Im1,Im2,Im3,Im4: real; Ex: boolean;
label 1,2,3,4;

begin
     F:=-1;
     R:=100*100;
     A:=X[1]; B:=X[2]; C:=X[3]; D:=X[4]; E:=X[5];
     M:=(C-A)*(C-A)+B*B;
     N:=2*E*(C-A)+2*B*D;
     P:=2*(C-A)*(F+A*R)+E*E-(B*B*R-D*D);
     Q:=2*E*(F+A*R)-2*B*D*R;
     S:=Sqr(F+A*R)-D*D*R;

     Dekart4(M,N,P,Q,S,Re1,Im1,Re2,Im2,Re3,Im3,Re4,Im4,Ex);

     Y1:=MCompl(Re1,Im1);
     Y2:=MCompl(Re2,Im2);
     Y3:=MCompl(Re3,Im3);
     Y4:=MCompl(Re4,Im4);

     X1:=SqrtIm(CompSub(MCompl(R,0),CompMul(Y1,Y1)));
     begin
          Verify:=X[1]*X1.Re*X1.Re+X[2]*X1.Re*Y1.Re+X[3]*Y1.Re*Y1.Re+X[4]*X1.Re+X[5]*Y1.Re-1;
          if Abs(Verify)>Eps then X1:=Neg(X1) else goto 1;
          Verify:=X[1]*X1.Re*X1.Re+X[2]*X1.Re*Y1.Re+X[3]*Y1.Re*Y1.Re+X[4]*X1.Re+X[5]*Y1.Re-1;
          if Abs(Verify)>Eps then begin X1:=Neg(X1); Y1:=Neg(Y1) end else goto 1;
          Verify:=X[1]*X1.Re*X1.Re+X[2]*X1.Re*Y1.Re+X[3]*Y1.Re*Y1.Re+X[4]*X1.Re+X[5]*Y1.Re-1;
          if Abs(Verify)>Eps then X1:=Neg(X1) else goto 1;
          Verify:=X[1]*X1.Re*X1.Re+X[2]*X1.Re*Y1.Re+X[3]*Y1.Re*Y1.Re+X[4]*X1.Re+X[5]*Y1.Re-1;

     end;
  1:

     X2:=SqrtIm(CompSub(MCompl(R,0),CompMul(Y2,Y2)));
     begin
          Verify:=X[1]*X2.Re*X2.Re+X[2]*X2.Re*Y2.Re+X[3]*Y2.Re*Y2.Re+X[4]*X2.Re+X[5]*Y2.Re-1;
          if Abs(Verify)>Eps then X2:=Neg(X2);
          Verify:=X[1]*X2.Re*X2.Re+X[2]*X2.Re*Y2.Re+X[3]*Y2.Re*Y2.Re+X[4]*X2.Re+X[5]*Y2.Re-1;
          if Abs(Verify)>Eps then begin X2:=Neg(X2); Y2:=Neg(Y2) end else goto 2;
          Verify:=X[1]*X2.Re*X2.Re+X[2]*X2.Re*Y2.Re+X[3]*Y2.Re*Y2.Re+X[4]*X2.Re+X[5]*Y2.Re-1;
          if Abs(Verify)>Eps then X2:=Neg(X2) else goto 2;
          Verify:=X[1]*X2.Re*X2.Re+X[2]*X2.Re*Y2.Re+X[3]*Y2.Re*Y2.Re+X[4]*X2.Re+X[5]*Y2.Re-1;
     end;
   2:
     X3:=SqrtIm(CompSub(MCompl(R,0),CompMul(Y3,Y3)));

     begin
          Verify:=X[1]*X3.Re*X3.Re+X[2]*X3.Re*Y3.Re+X[3]*Y3.Re*Y3.Re+X[4]*X3.Re+X[5]*Y3.Re-1;
          if Abs(Verify)>Eps then X3:=Neg(X3);
          Verify:=X[1]*X3.Re*X3.Re+X[2]*X3.Re*Y3.Re+X[3]*Y3.Re*Y3.Re+X[4]*X3.Re+X[5]*Y3.Re-1;
          if Abs(Verify)>Eps then begin X3:=Neg(X3); Y3:=Neg(Y3) end else goto 3;
          Verify:=X[1]*X3.Re*X3.Re+X[2]*X3.Re*Y3.Re+X[3]*Y3.Re*Y3.Re+X[4]*X3.Re+X[5]*Y3.Re-1;
          if Abs(Verify)>Eps then X3:=Neg(X3) else goto 3;
          Verify:=X[1]*X3.Re*X3.Re+X[2]*X3.Re*Y3.Re+X[3]*Y3.Re*Y3.Re+X[4]*X3.Re+X[5]*Y3.Re-1;
     end;
    3:
     X4:=SqrtIm(CompSub(MCompl(R,0),CompMul(Y4,Y4)));
     begin
          Verify:=X[1]*X4.Re*X4.Re+X[2]*X4.Re*Y4.Re+X[3]*Y4.Re*Y4.Re+X[4]*X4.Re+X[5]*Y4.Re-1;
          if Abs(Verify)>Eps then X4:=Neg(X4);
          Verify:=X[1]*X4.Re*X4.Re+X[2]*X4.Re*Y4.Re+X[3]*Y4.Re*Y4.Re+X[4]*X4.Re+X[5]*Y4.Re-1;
          if Abs(Verify)>Eps then begin X4:=Neg(X4); Y4:=Neg(Y4) end else goto 4;
          Verify:=X[1]*X4.Re*X4.Re+X[2]*X4.Re*Y4.Re+X[3]*Y4.Re*Y4.Re+X[4]*X4.Re+X[5]*Y4.Re-1;
          if Abs(Verify)>Eps then X4:=Neg(X4) else goto 4;
          Verify:=X[1]*X4.Re*X4.Re+X[2]*X4.Re*Y4.Re+X[3]*Y4.Re*Y4.Re+X[4]*X4.Re+X[5]*Y4.Re-1;
     end;
    4:
end;

procedure Dekart4(A,B,C,D,E: real; var Re1,Im1,Re2,Im2,Re3,Im3,Re4,Im4: real;
                   var Ex:boolean);
const
  w=1E-15;
var
  p, q, r: real;
  A0, B0, C0, D0, S0: real;
  z1, z2, z3, h1, h2, h3: real;
  R1, R2, R3, I1, I2, I3, F0: real;
begin
  Ex:= False;  R1:=0; R2:=0; R3:=0; I1:=0; I2:=0; I3:=0; F0:=0; 
  p:= (8*A*C-3*B*B)/(8*A*A);
  q:= (8*A*A*D+B*B*B-4*A*B*C)/(8*A*A*A);
  r:= (16*A*B*B*C-64*A*A*B*D-3*B*B*B*B+256*A*A*A*E)/(256*A*A*A*A);
  A0:= 1;
  B0:= p/2;
  C0:= (p*p-4*r)/16;
  D0:= -q*q/64;
  Kardano3(A0, B0, C0, D0, S0, z1, h1, z2, h2, z3, h3);
  if ((S0<0) or (S0=0)) and ((abs(z1)<w) or (abs(z2)<w) or (abs(z3)<w))
    then
      begin
        Ex:=True;
        Exit;
      end;
  if (S0>0) and ((z1<0) or (abs(z1)<w))
    then
      begin
        Ex:=True;
        Exit;
      end;
  if (S0<0) or (S0=0)
    then
      begin
        if (z1>0) and (z2>0) and (z3>0)
          then
            begin
              if q<0
                then
                  begin
                    R1:=Sqrt(z1); R2:=Sqrt(z2); R3:=Sqrt(z3);
                    I1:=0; I2:=0; I3:=0;
                  end
                else
                  begin
                    R1:=-Sqrt(z1); R2:=Sqrt(z2); R3:=Sqrt(z3);
                    I1:=0; I2:=0; I3:=0;
                  end;
            end;
        if (z1>0) and (z2<0) and (z3<0)
          then
            begin
              if q<0
                then
                  begin
                    R1:=-Sqrt(z1);  R2:=0; R3:=0;
                    I1:=0; I2:=Sqrt(-z2); I3:=Sqrt(-z3);
                  end
                else
                  begin
                    R1:=Sqrt(z1);  R2:=0; R3:=0;
                    I1:=0; I2:=Sqrt(-z2); I3:=Sqrt(-z3);
                  end;
            end;
        if (z2>0) and (z1<0) and (z3<0)
          then
            begin
              if q<0
                then
                  begin
                    R2:=-Sqrt(z2);  R1:=0; R3:=0;
                    I2:=0; I1:=Sqrt(-z1); I3:=Sqrt(-z3);
                  end
                else
                  begin
                    R2:=Sqrt(z2);  R1:=0; R3:=0;
                    I2:=0; I1:=Sqrt(-z1); I3:=Sqrt(-z3);
                  end;
            end;
        if (z3>0) and (z1<0) and (z2<0)
          then
            begin
              if q<0
                then
                  begin
                    R3:=-Sqrt(z3);  R1:=0; R2:=0;
                    I3:=0; I1:=Sqrt(-z2); I2:=Sqrt(-z3);
                  end
                else
                  begin
                    R3:=Sqrt(z3);  R1:=0; R2:=0;
                    I3:=0; I1:=Sqrt(-z1); I2:=Sqrt(-z3);
                  end;
            end;
        Re1:= R1+R2+R3-B/(4*A);
        Im1:= I1+I2+I3;
        Re2:= R1-R2-R3-B/(4*A);
        Im2:= I1-I2-I3;
        Re3:= R2-R1-R3-B/(4*A);
        Im3:= I2-I1-I3;
        Re4:= R3-R1-R2-B/(4*A);
        Im4:= I3-I1-I2;
      end;
  if S0>0
    then
      begin
        if z2>0 then F0:= Arctan(h2/z2);
        if z2<0 then F0:= Arctan(h2/z2)+Pi;
        if (z2=0) and (h2>0) then F0:= Pi/2;
        if (z2=0) and (h2<0) then F0:= -Pi/2;
        if q<0 then R1:= Sqrt(z1);
        if q>0 then R1:= -Sqrt(z1);
        Re1:= R1+2*Sqrt(Sqrt(z2*z2+h2*h2))*Cos(F0/2)-B/(4*A);
        Im1:= 0;
        Re2:= R1-2*Sqrt(Sqrt(z2*z2+h2*h2))*Cos(F0/2)-B/(4*A);
        Im2:= 0;
        Re3:= -R1-B/(4*A);
        Im3:= 2*Sqrt(Sqrt(z2*z2+h2*h2))*Sin(F0/2);
        Re4:= -R1-B/(4*A);
        Im4:= -2*Sqrt(Sqrt(z2*z2+h2*h2))*Sin(F0/2);
      end;
end; // Dekart4