Определить количество общих точек у двух отрезков, заданных координатами своих концов - Delphi - Ответ 4850345

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows, Math;
 
Type
  TPoint = Record
    X,Y : Extended;
  End;
 
Procedure VvodCoor(Prompt:String;Var V:Extended);
Var
  s : String;
  i : Integer;
Begin
  Repeat
    Write(Prompt);
    ReadLn(s);
    Val(s,V,i);
    If i=0 Then Break;
    WriteLn('Значение набрано неправильно !!!');
  Until False;
End;
 
Var
  A,B,C,D : TPoint;
  k1,b1,k2,b2,x,y : Extended;
  s : String;
begin
  //Переключение окна консоли на кодовую страницу CP1251 (Win-1251).
  //Если после переключения русские буквы показываются неверно,
  //следует открыть системное меню консольного окна - щелчком мыши в левом
  //верхнем углу окна консоли и выбрать:
  //Свойства - закладка "Шрифт" - выбрать шрифт: "Lucida Console".
  SetConsoleOutputCp(1251);
  SetConsoleCP(1251);
 
  WriteLn('Введите координаты концов отрезка [A,B]');
  VvodCoor('A.X > ',A.X);
  VvodCoor('A.Y > ',A.Y);
  VvodCoor('B.X > ',B.X);
  VvodCoor('B.Y > ',B.Y);
  WriteLn('Введите координаты концов отрезка [C,D]');
  VvodCoor('C.X > ',C.X);
  VvodCoor('C.Y > ',C.Y);
  VvodCoor('D.X > ',D.X);
  VvodCoor('D.Y > ',D.Y);
  WriteLn;
 
  //Подготовка...
  If A.X>B.X Then
  //Поменяем местами
  Begin
    k1:=A.X; k2:=A.Y;
    A:=B;
    B.X:=k1; B.Y:=k2;
    s:='BA'; //Для корректной выдачи отрезков
  End Else s:='AB';
  If C.X>D.X Then
  //Поменяем местами
  Begin
    k1:=C.X; k2:=C.Y;
    C:=D;
    D.X:=k1; D.Y:=k2;
    s:=s+'DC';
  End Else s:=s+'CD';
 
 
  If (B.X-A.X)=0 Then
  //Отрезок [A,B] параллелен оси OY
  Begin
    k1:=INFINITE; //Бесконечность
    b1:=A.X;
  End Else
  Begin
    //Коэффициент наклона прямой A-B
    //к оси OX координат
    k1:=(B.Y-A.Y)/(B.X-A.X);
    //Смещение по оси OY
    b1:=A.Y-k1*A.X;
  End;
 
  If (C.X-D.X)=0 Then
  //Отрезок [C,D] параллелен оси OY
  Begin
    k2:=INFINITE; //Бесконечность
    b2:=C.X;
  End Else
  Begin
    //Коэффициент наклона прямой C-D
    //к оси OX координат
    k2:=(D.Y-C.Y)/(D.X-C.X);
    //Смещение по оси OY
    b2:=C.Y-k2*C.X;
  End;
 
  //Проверяем пересекаемость...
  If k1=k2 Then
  //Прямые, на которых лежат отрезки, параллельны
  Begin
    If b1=b2 Then
    //Праллельные отрезки лежат на одной прямой
    //Могут пересекаться
    Begin
      If ((A.X>=C.X) And (A.X<=D.X)) Then
      WriteLn('Отрезки накладываются - отрезок [',s[1],',',s[4],']') Else
      If ((B.X>=C.X) And (B.X<=D.X)) Then
      WriteLn('Отрезки накладываются - отрезок [',s[3],',',s[2],']') Else
      WriteLn('Отрезки не пересекаются...');
    End Else
    WriteLn('Отрезки не пересекаются...');
  End Else
  //Прямые, на которых лежат отрезки, пересекаются в одной точке
  //  y = k1*x + b1               =>    x * ( k1 - k2 ) = b2 - b1
  //  y = k2*x + b2   Решим СЛАУ  =>
  //  x = ( b2 - b1 ) / ( k1 - k2 )
  Begin
    //Проверим, лежит ли точка на отрезке...
    If k1=INFINITE Then
    //Отрезок [A,B] параллелен оси OY
    Begin
      x:=b1;      //Координата X точки пересечения прямых
      y:=k2*x+b2; //Координата Y
    End Else
    If k2=INFINITE Then
    //Отрезок [C,D] параллелен оси OY
    Begin
      x:=b2;      //Координата X точки пересечения прямых
      y:=k1*x+b1; //Координата Y
    End Else
    Begin
      x:=(b2-b1)/(k1-k2); //Координата X точки пересечения прямых
      y:=k1*x+b1;         //Координата Y
    End;
    //Проверка лежит ли точка на обоих отрезках
    If InRange(x, Min(A.X,B.X), Max(A.X,B.X)) And
    InRange(y, Min(A.Y,B.Y), Max(A.Y,B.Y)) And
    InRange(x, Min(C.X,D.X), Max(C.X,D.X)) And
    InRange(y, Min(C.Y,D.Y), Max(C.Y,D.Y)) Then
    WriteLn('Отрезки пересекаются в точке : [',x:5:2,y:5:2,']') Else
    WriteLn('Отрезки не пересекаются...');
  End;
  ReadLn;
end.