Начертить треугольники по координатам, чтобы они не пересекались

//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(aA, aB, aC : TPoint) : Extended;
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (aLine1, aLine2 : TLine) : Boolean;
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(aTri : TTriangle; aDot : TPoint) : Boolean;
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(aTri1, aTri2 : TTriangle) : Boolean;

unit UTriangle;
 
interface
 
uses
  Windows, Math;
 
type
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A         : TPoint;
    B         : TPoint;
    C         : TPoint;
  end;
 
  //Тип - линия (AB).
  TLine = record
    A         : TPoint;
    B         : TPoint;
    //Длина линии.
    Length    : Extended;
  end;
 
const
  //Значение радиана (в градусах):
  Radian         : Extended = 180 / Pi;
  //Размер квадратной матрицы - 20x20 точек.
  N = 20;
  //Точность сравнения длин отрезков. Расстояние между ближайшими соседними точками сетки,
  //взятое по оси Х или по оси Y равно 1.
  EpsilonLen     : Extended = 0.2;
  //Точность сравнения углов. В градусах.
  EpsilonAngle   : Extended = 0.001;
  //Точность сравнения параметров уравнений прямых.
  EpsilonKoef    : Extended = 0.001;
 
//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(aA, aB, aC : TPoint) : Extended;
 
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (aLine1, aLine2 : TLine) : Boolean;
 
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(aTri : TTriangle; aDot : TPoint) : Boolean;
 
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(aTri1, aTri2 : TTriangle) : Boolean;
 
 
implementation
 
 
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (aLine1, aLine2 : TLine) : Boolean;
var
  //Флаг, показыавющий параллелен ли отрезок оси Y.
  LineVert1,
  LineVert2       : Boolean;
 
  //Параметры уравнения прямой aLine1.
  K1, C1,
  //Параметры уравнения прямой aLine2.
  K2, C2          : Extended;
  //Координаты точки пересечения прямых aLine1 и aLine2.
  XCross, YCross  : Extended;
begin
 
  Result := False;
 
  //Будем использовать "уравнение прямой с уголовым коэффициентом":
  //Уравнение прямой aLine1: Y = K1*X + C1;
  //Уравнение прямой aLine2: Y = K2*X + C2;
  //Уравнение такого вида не определено в случае, когда прямая параллельна оси Y.
 
  //Провека наложения проекций отрезков на оси X и Y.
  //Если имеется наложение проекций по обеим осям, тогда пересечение отрезков возможно.
  //Если хотябы на одной из осей наложения не обнаружено - такие отрезки не могут пересекаться.
  if
    not (
      ( ( aLine1.A.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.A.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine1.B.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.B.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine2.A.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.A.X <= Max(aLine1.A.X, aLine1.B.X) ) )
      or ( ( aLine2.B.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.B.X <= Max(aLine1.A.X, aLine1.B.X) ) )
    )
  then begin
    Result := False;
    Exit;
  end;
 
  //Параллельность отрезка aLine1 оси Y.
  LineVert1 := False;
  if aLine1.A.X = aLine1.B.X then begin
    LineVert1 := True;
  end;
 
  //Параллельность отрезка aLine2 оси Y.
  LineVert2 := False;
  if aLine2.A.X = aLine2.B.X then begin
    LineVert2 := True;
  end;
 
  if LineVert1 and LineVert2 then begin
    //Случай, когда оба отрезка параллельны оси Y.
    if aLine1.A.X = aLine2.A.X then begin
      //Оба отрезка расположены на одной прямой.
      //Отрезки пересекаются.
      Result := True;
    end else begin
      //Отрезки расположены на разных прямых. Значит - не могут пересекаться.
      Result := False;
    end;
    Exit;
  end;
 
  if not LineVert1 then begin
    //Отрезок aLine1 не параллелен оси Y.
    //Значит, можно составить уравнение с угловым коэффициентом.
    //Параметры прямой aLine1.
    K1 := (aLine1.A.Y - aLine1.B.Y) / (aLine1.A.X - aLine1.B.X);
    C1 := aLine1.A.Y - K1 * aLine1.A.X;
 
    if LineVert2 then begin
      //Отрезок aLine2 параллелен оси Y.
      //Координаты точки пересечения прямых aLine1 и aLine2.
      XCross := aLine2.A.X;
      YCross := K1 * XCross + C1;
      if
            ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
        and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
      //and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
        and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
      then begin
        //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
        //Т. о. отрезки пересекаются.
        Result := True;
      end else begin
        //Координаты точки пересечения прямых не накладываются на все проекции
        //обоих отрезков.
        Result := False;
      end;
      Exit;
    end;
  end;
 
  if not LineVert2 then begin
    //Отрезок aLine2 не параллелен оси Y.
    //Значит, можно составить уравнение с угловым коэффициентом.
    //Параметры прямой aLine2.
    K2 := (aLine2.A.Y - aLine2.B.Y) / (aLine2.A.X - aLine2.B.X);
    C2 := aLine2.A.Y - K2 * aLine2.A.X;
 
    if LineVert1 then begin
      //Отрезок aLine2 параллелен оси Y.
      //Координаты точки пересечения прямых aLine1 и aLine2.
      XCross := aLine1.A.X;
      YCross := K2 * XCross + C2;
      if
          //( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
            ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
        and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
        and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
      then begin
        //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
        //Т. о. отрезки пересекаются.
        Result := True;
      end else begin
        //Координаты точки пересечения прямых не накладываются на все проекции
        //обоих отрезков.
        Result := False;
      end;
      Exit;
    end;
  end;
 
  //Ни один из отрезков не параллелен оси Y.
 
  //Координаты точки пересечения двух прямых неопределены, если прямые
  //параллельны друг другу.
 
  if SameValue(K1, K2, EpsilonKoef) then begin
    //Случай, когда отрезки параллельны друг другу.
    if SameValue(C1, C2, EpsilonKoef) then begin
      //Оба отрезка лежат на одной и той же прямой.
      //Отрезки пересекаются (накладываются).
      Result := True;
    end else begin
      //Отрезки лежат на разных параллельних прямых. Т. е. не пересекаются.
      Result := False;
    end;
    Exit;
  end;
 
  //Отрезки лежат на прямых, непараллельных друг другу.
 
  //Точка пересечения прямых.
 
  XCross := (C1 - C2) / (K2 - K1);
  YCross := (K2 * C1 - K1 * C2) / (K2 - K1);
  if
        ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
    and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
    and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
    and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
  then begin
    //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
    //Т. о. отрезки пересекаются.
    Result := True;
  end else begin
    //Координаты точки пересечения прямых не накладываются на все проекции
    //обоих отрезков.
    Result := False;
  end;
 
end;
 
//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(aA, aB, aC : TPoint) : Extended;
var
  LineBA    : Extended;
  LineBC    : Extended;
  LineAC    : Extended;
  CosABC    : Extended;
begin
 
  // Теорема косинусов:
  //AC^2 = BA^2 + BC^2 - 2*BA*BC*cosABC
  //-> cosABC = (AC^2 - BA^2 - BC^2)/2*BA*BC
  //-> ABC = ArcCos( cosABC ) - В радианах
  //-> ABC = ArcCos( cosABC ) * Radian - В градусах.
 
  LineBA := Sqrt( Sqr(aB.X - aA.X) + Sqr(aB.Y - aA.Y) );
  LineBC := Sqrt( Sqr(aB.X - aC.X) + Sqr(aB.Y - aC.Y) );
  LineAC := Sqrt( Sqr(aA.X - aC.X) + Sqr(aA.Y - aC.Y) );
 
  CosABC := ( - Sqr(LineAC) + Sqr(LineBA) + Sqr(LineBC) ) / ( 2 * LineBA * LineBC );
 
  //Так как функция ArcCos(CosABC) не определена для аргументов CosABC > 1 и CosABC < -1, а при
  //вычисленях с плавающей точкой возможны небольшие "заскоки" за область допустимых значений, то
  //такие случаи предусмотрим в коде.
  if CosABC > 1 then begin
    CosABC := 1;
  end else if CosABC < -1 then begin
    CosABC := -1;
  end;
 
  Result := Radian * ArcCos(CosABC);
 
end;
 
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(aTri : TTriangle; aDot : TPoint) : Boolean;
begin
  //Если точка D расположена внутри треугольника ABC, то выполнятся следующие 3 условия:
  //1. Углы: ABD + CBD = ABC
  //2. Углы: ACD + BCD = ACB
  //3. Углы: BAD + CAD = BAC
  //Если точка D расположена вне треугольника ABC, то какие-то два из трёх приведенных
  //выше условий будут нарушены таким образом:
  //1. Углы: ABD + CBD > ABC
  //2. Углы: ACD + BCD > ACB
  //3. Углы: BAD + CAD > BAC
  //Если при последовательной проверке трёх обнаружено первое нарушение -
  //это однозначно говорит о том, что точка D лежит за пределами треугольника ABC.
  //На этом и построим алгоритм.
  //
  //                     <A>
  //                     /|\
  //                    / | \
  //                   /  |  \
  //                  /   |   \
  //                 /    |    \
  //                /    <D>    \
  //               /   /     \   \
  //              /  /         \  \
  //             / /             \ \
  //            //                 \\
  //          <B>-------------------<C>
 
  Result := False;
 
  //Углы ABD, AСD, BAD неопределены, в случае, если точка D совпадает с любой
  //из вершин треугольника ABC. Поэтому предусмотрим этот случай.
  if
    ( (aTri.A.X = aDot.X) and (aTri.A.Y = aDot.Y) )
    or ( (aTri.B.X = aDot.X) and (aTri.B.Y = aDot.Y) )
    or ( (aTri.C.X = aDot.X) and (aTri.C.Y = aDot.Y) )
  then begin
    Result := True;
    Exit;
  end;
 
  //1. Если углы: ABD + CBD > ABC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.B, aDot) + GetAngleABC(aTri.C, aTri.B, aDot)
      - GetAngleABC(aTri.A, aTri.B, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //2. Если углы: ACD + BCD > ACB -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.C, aDot) + GetAngleABC(aTri.B, aTri.C, aDot)
      - GetAngleABC(aTri.A, aTri.C, aTri.B)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //3. Если углы: BAD + CAD > BAC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.B, aTri.A, aDot) + GetAngleABC(aTri.C, aTri.A, aDot)
      - GetAngleABC(aTri.B, aTri.A, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //4. Точка D лежит внутри треугольника.
 
  Result := True;
end;
 
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(aTri1, aTri2 : TTriangle) : Boolean;
var
  aLine1, aLine2       : TLine;
begin
  Result := True;
 
  //Пересекается ли сторона AB треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.A;
  aLine1.B := aTri1.B;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона BC треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.B;
  aLine1.B := aTri1.C;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона CA треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.C;
  aLine1.B := aTri1.A;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //В этой точке алгоритма мы знаем, что стороны треугольников не пересекаются.
  //Теперь проверяем не лежит ли один треугольник полностью внутри другого.
  //Если один треугольник полностью лежит внутри другого, это означает, что все
  //вершины этого треугольника тоже лежат внутри другого.
  //Поэтому нам достаточно выполнить такую проверку только для одной вершнины каждого
  //из треугольников.
  //Если один треугольник полностью лежит внутри другого, то будем считать, что
  //такие треугольники пересекаются.
 
  //Если треугольник aTri2 полностью лежит внутри треугольника aTri1, то все
  //вершины треугольника aTri2 лежат внутри треугольника aTri1.
  if DotInTriangle(aTri1, aTri2.A) then begin
    Exit;
  end;
 
  //Если треугольник aTri1 полностью лежит внутри треугольника aTri2, то все
  //вершины треугольника aTri1 лежат внутри треугольника aTri2.
  if DotInTriangle(aTri2, aTri1.A) then begin
    Exit;
  end;
 
  Result := False;
end;
 
end.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    BtnClearMemo: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    BtnClearCnv: TButton;
    procedure Button1Click(Sender: TObject);
    procedure BtnClearMemoClick(Sender: TObject);
    procedure BtnClearCnvClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A         : TPoint;
    B         : TPoint;
    C         : TPoint;
  end;
 
  //Тип - линия (AB).
  TLine = record
    A         : TPoint;
    B         : TPoint;
  end;
 
  //Тип массива для хранения треугольников. Вид массива - динамический.
  TArrTriangle   = array of TTriangle;
 
const
  //Значение радиана (в градусах):
  Radian         : Extended = 180 / Pi;
  //Точность сравнения длин отрезков. Расстояние между ближайшими соседними точками сетки,
  //взятое по оси Х или по оси Y равно 1.
  EpsilonLen     : Extended = 0.1;
  //Точность сравнения углов. В градусах.
  EpsilonAngle   : Extended = 0.001;
  //Точность сравнения параметров уравнений прямых.
  EpsilonKoef    : Extended = 0.001;
 
var
  Form1: TForm1;
 
implementation
 
uses Math;
 
{$R *.dfm}
 
//------------------------------------------------------------------------------
//Рисование на канве.
//------------------------------------------------------------------------------
 
//Рисует треугольник aTri на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawTri(aCanvas : TCanvas; aZoom : Integer; var aTri : TTriangle);
begin
  aCanvas.MoveTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.B.X) * aZoom, Pred(aTri.B.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.C.X) * aZoom, Pred(aTri.C.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
end;
 
//Рисует на канве aCanvas массив треугольников, на который ссылается указатель aPArrTri.
//При прорисовке применяет масштаб aZoom.
procedure DrawArrTri(aCanvas : TCanvas; aZoom : Integer; var aArrTri : TArrTriangle);
var
  i : Integer;
begin
  for i := 0 to High(aArrTri) do begin
    DrawTri(aCanvas, aZoom, aArrTri[i]);
  end;
end;
 
//------------------------------------------------------------------------------
//Вычисления.
//------------------------------------------------------------------------------
 
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (var aLine1, aLine2 : TLine) : Boolean;
var
  //Флаг, показыавющий параллелен ли отрезок оси Y.
  LineVert1,
  LineVert2       : Boolean;
 
  //Параметры уравнения прямой aLine1.
  K1, C1,
  //Параметры уравнения прямой aLine2.
  K2, C2          : Extended;
  //Координаты точки пересечения прямых aLine1 и aLine2.
  XCross, YCross  : Extended;
begin
 
  Result := False;
 
  //Будем использовать "уравнение прямой с уголовым коэффициентом":
  //Уравнение прямой aLine1: Y = K1*X + C1;
  //Уравнение прямой aLine2: Y = K2*X + C2;
  //Уравнение такого вида не определено в случае, когда прямая параллельна оси Y.
 
  //Провека наложения проекций отрезков на оси X и Y.
  //Если имеется наложение проекций по обеим осям, тогда пересечение отрезков возможно.
  //Если хотябы на одной из осей наложения не обнаружено - такие отрезки не могут пересекаться.
  if
    not (
      ( ( aLine1.A.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.A.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine1.B.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.B.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine2.A.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.A.X <= Max(aLine1.A.X, aLine1.B.X) ) )
      or ( ( aLine2.B.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.B.X <= Max(aLine1.A.X, aLine1.B.X) ) )
    )
  then begin
    Exit;
  end;
 
  //Параллельность отрезка aLine1 оси Y.
  LineVert1 := False;
  if aLine1.A.X = aLine1.B.X then begin
    LineVert1 := True;
  end;
 
  //Параллельность отрезка aLine2 оси Y.
  LineVert2 := False;
  if aLine2.A.X = aLine2.B.X then begin
    LineVert2 := True;
  end;
 
  //Параметры прямых.
 
  if not LineVert1 then begin
    //Параметры прямой aLine1.
    K1 := (aLine1.A.Y - aLine1.B.Y) / (aLine1.A.X - aLine1.B.X);
    C1 := aLine1.A.Y - K1 * aLine1.A.X;
  end;
 
  if not LineVert2 then begin
    //Параметры прямой aLine2.
    K2 := (aLine2.A.Y - aLine2.B.Y) / (aLine2.A.X - aLine2.B.X);
    C2 := aLine2.A.Y - K2 * aLine2.A.X;
  end;
 
  //Определение пересекаются ли отрезки.
 
  //Если хотябы один отрезок параллелен оси Y.
 
  //Оба отрезка параллельны оси Y.
  if LineVert1 and LineVert2 then begin
    Exit;
  end;
 
  if LineVert1 and (not LineVert2) then begin
    //Отрезок aLine1 параллелен оси Y, а отрезок aLine2 не параллелен оси Y.
 
    //Координаты точки пересечения прямых aLine1 и aLine2.
    XCross := aLine1.A.X;
    YCross := K2 * XCross + C2;
  end else if (not LineVert1) and LineVert2 then begin
    //Отрезок aLine2 параллелен оси Y, а отрезок aLine1 не параллелен оси Y.
 
    //Координаты точки пересечения прямых aLine1 и aLine2.
    XCross := aLine2.A.X;
    YCross := K1 * XCross + C1;
  end else begin
    //Отрезоки aLine1 и aLine2 непараллелены оси Y.
 
    //Если отрезки параллельны друг другу.
    if SameValue(K1, K2, EpsilonKoef) then begin
      Exit;
    end;
 
    //Отрезки непараллельны друг другу.
 
    XCross := (C1 - C2) / (K2 - K1);
    YCross := (K2 * C1 - K1 * C2) / (K2 - K1);
  end;
 
  //Наложение координат точки пересечения прямых на проекции отрезков.
  if
    not (
          ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
      and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
      and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
      and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
    )
  then begin
    //Координаты точки пересечения прямых не накладываются на все проекции
    //обоих отрезков.
    Exit;
  end;
 
  //Проверяем касаются ли отрезки.
  if
       ( SameValue(aLine1.A.X, XCross, EpsilonLen) and SameValue(aLine1.A.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine1.B.X, XCross, EpsilonLen) and SameValue(aLine1.B.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine2.A.X, XCross, EpsilonLen) and SameValue(aLine2.A.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine2.B.X, XCross, EpsilonLen) and SameValue(aLine2.B.Y, YCross, EpsilonLen) )
  then begin
    Exit;
  end;
 
  Result := True;
end;
 
//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(var aA, aB, aC : TPoint) : Extended;
var
  LineBA    : Extended;
  LineBC    : Extended;
  LineAC    : Extended;
  CosABC    : Extended;
begin
 
  // Теорема косинусов:
  //AC^2 = BA^2 + BC^2 - 2*BA*BC*cosABC
  //-> cosABC = (AC^2 - BA^2 - BC^2)/2*BA*BC
  //-> ABC = ArcCos( cosABC ) - В радианах
  //-> ABC = ArcCos( cosABC ) * Radian - В градусах.
 
  LineBA := Sqrt( Sqr(aB.X - aA.X) + Sqr(aB.Y - aA.Y) );
  LineBC := Sqrt( Sqr(aB.X - aC.X) + Sqr(aB.Y - aC.Y) );
  LineAC := Sqrt( Sqr(aA.X - aC.X) + Sqr(aA.Y - aC.Y) );
 
  CosABC := ( - Sqr(LineAC) + Sqr(LineBA) + Sqr(LineBC) ) / ( 2 * LineBA * LineBC );
 
  //Так как функция ArcCos(CosABC) не определена для аргументов CosABC > 1 и CosABC < -1, а при
  //вычисленях с плавающей точкой возможны небольшие "заскоки" за область допустимых значений, то
  //такие случаи предусмотрим в коде.
  if CosABC > 1 then begin
    CosABC := 1;
  end else if CosABC < -1 then begin
    CosABC := -1;
  end;
 
  Result := Radian * ArcCos(CosABC);
 
end;
 
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(var aTri : TTriangle; var aDot : TPoint) : Boolean;
begin
  //Если точка D расположена внутри треугольника ABC, то выполнятся следующие 3 условия:
  //1. Углы: ABD + CBD = ABC
  //2. Углы: ACD + BCD = ACB
  //3. Углы: BAD + CAD = BAC
  //Если точка D расположена вне треугольника ABC, то какие-то два из трёх приведенных
  //выше условий будут нарушены таким образом:
  //1. Углы: ABD + CBD > ABC
  //2. Углы: ACD + BCD > ACB
  //3. Углы: BAD + CAD > BAC
  //Если при последовательной проверке трёх обнаружено первое нарушение -
  //это однозначно говорит о том, что точка D лежит за пределами треугольника ABC.
  //На этом и построим алгоритм.
  //
  //                     <A>
  //                     /|\
  //                    / | \
  //                   /  |  \
  //                  /   |   \
  //                 /    |    \
  //                /    <D>    \
  //               /   /     \   \
  //              /  /         \  \
  //             / /             \ \
  //            //                 \\
  //          <B>-------------------<C>
 
  Result := False;
 
  //Углы ABD, AСD, BAD неопределены, в случае, если точка D совпадает с любой
  //из вершин треугольника ABC. Поэтому предусмотрим этот случай.
  if
    ( (aTri.A.X = aDot.X) and (aTri.A.Y = aDot.Y) )
    or ( (aTri.B.X = aDot.X) and (aTri.B.Y = aDot.Y) )
    or ( (aTri.C.X = aDot.X) and (aTri.C.Y = aDot.Y) )
  then begin
    Result := True;
    Exit;
  end;
 
  //1. Если углы: ABD + CBD > ABC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.B, aDot) + GetAngleABC(aTri.C, aTri.B, aDot)
      - GetAngleABC(aTri.A, aTri.B, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //2. Если углы: ACD + BCD > ACB -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.C, aDot) + GetAngleABC(aTri.B, aTri.C, aDot)
      - GetAngleABC(aTri.A, aTri.C, aTri.B)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //3. Если углы: BAD + CAD > BAC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.B, aTri.A, aDot) + GetAngleABC(aTri.C, aTri.A, aDot)
      - GetAngleABC(aTri.B, aTri.A, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //4. Точка D лежит внутри треугольника.
 
  Result := True;
end;
 
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(var aTri1, aTri2 : TTriangle) : Boolean;
var
  Line1, Line2       : TLine;
begin
  Result := True;
 
  //(*Отладка
  //(1, 1); (1, 2); (2, 1)
  //(1, 1); (2, 6); (6, 1)
  if
    //(aTri1.A.X = 1) and (aTri1.A.Y = 1) and (aTri1.B.X = 1) and (aTri1.B.Y = 2) and (aTri1.C.X = 2) and (aTri1.C.Y = 1)
    (aTri2.A.X = 1) and (aTri2.A.Y = 1) and (aTri2.B.X = 2) and (aTri2.B.Y = 6) and (aTri2.C.X = 6) and (aTri2.C.Y = 1)
  then begin
    Line1 := Line2;
  end;
  //*)
 
  //Пересекается ли сторона AB треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.A;
  Line1.B := aTri1.B;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона BC треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.B;
  Line1.B := aTri1.C;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона CA треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.C;
  Line1.B := aTri1.A;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //В этой точке алгоритма мы знаем, что стороны треугольников не пересекаются.
  //Теперь проверяем не лежит ли один треугольник полностью внутри другого.
  //Если один треугольник полностью лежит внутри другого, это означает, что все
  //вершины этого треугольника тоже лежат внутри другого.
  //Если один треугольник полностью лежит внутри другого, то будем считать, что
  //такие треугольники пересекаются.
 
  //Расположен ли треугольник aTri2 внутри треугольника aTri1.
  if
    DotInTriangle(aTri1, aTri2.A)
    and DotInTriangle(aTri1, aTri2.B)
    and DotInTriangle(aTri1, aTri2.C)
  then begin
    Exit;
  end;
 
  //Расположен ли треугольник aTri1 внутри треугольника aTri2.
  if
    DotInTriangle(aTri2, aTri1.A)
    and DotInTriangle(aTri2, aTri1.B)
    and DotInTriangle(aTri2, aTri1.C)
  then begin
    Exit;
  end;
 
  Result := False;
end;
 
//Проверяет: пересекается ли треугольник aTri хотябы с одним треугольником
//из массива aArrTri.
function CrossArrTri(var aTri : TTriangle; const aArrTri : TArrTriangle;
  var aTriCount : Integer) : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := 0 to aTriCount - 1 do begin
    Result := CrossTriangle(aTri, aArrTri[i]);
    if Result then Exit;
  end;
end;
 
//Проверяет: не является ли треугольник aTri вырожденным в отрезок.
//True - является вырожденным в отрезок.
//False - не является вырожденным в отрезок.
function IsDegTri(var aTri : TTriangle) : Boolean;
begin
  Result := True;
 
  if GetAngleABC(aTri.A, aTri.B, aTri.C) < EpsilonAngle then Exit;
 
  if Abs( GetAngleABC(aTri.A, aTri.B, aTri.C) - 180 ) < EpsilonAngle then Exit;
 
  Result := False;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity = 100;
var
  //Размер квадратной матрицы - NxN точек. //Желательно N = 2..10. Т. к. при
  //больших значениях программа будет выполняться долго.
  N             : Integer;
  //Массив исходных точек.
  ArrDot        : array of TPoint;
  //Массив непересекающихся треугольников.
  ArrTri        : TArrTriangle;
 
  //Количество непересекающихся треугольников.
  TriCount      : Integer;
  //Треугольник.
  Tri           : TTriangle;
  //Счётчики для циклов.
  I, J, K       : Integer;
  //Координаты точки.
  X, Y          : Integer;
begin
 
  N := StrToIntDef(Edit1.Text, 0);
  if (N < 2) or (N > 10) then begin
    ShowMessage('Число N должно быть в диапазоне: 1..10. Повторите ввод.');
    Exit;
  end;
 
  //Очистка канвы и Мемо.
  Image1.Canvas.FillRect(Image1.ClientRect);
  Memo1.Clear;
 
  //Подготовка исходных данных для задачи.
 
  //Квадратная сетка из точек: 10х10. Выглядит так:
 
  //     1   2   3   4   5   6   7   8   9   10
  //  1  .   .   .   .   .   .   .   .   .   .
 
  //  2  .   .   .   .   .   .   .   .   .   .
 
  //  3  .   .   .   .   .   .   .   .   .   .
 
  //  4  .   .   .   .   .   .   .   .   .   .
 
  //  5  .   .   .   .   .   .   .   .   .   .
 
  //  6  .   .   .   .   .   .   .   .   .   .
 
  //  7  .   .   .   .   .   .   .   .   .   .
 
  //  8  .   .   .   .   .   .   .   .   .   .
 
  //  9  .   .   .   .   .   .   .   .   .   .
 
  // 10  .   .   .   .   .   .   .   .   .   .
 
  SetLength(ArrDot, N * N);
 
  //Формируем массив точек.
  for X := 1 to N do begin
    for Y := 1 to N do begin
      I := ( Pred(X) * N + Y ) - 1;
      ArrDot[I].X := X;
      ArrDot[I].Y := Y;
    end;
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Решение первой части задачи. - Поиск равносторонних треугольников.
 
  //Если массив треугольников не пустой, то обнуляем его
  SetLength(ArrTri, 0);
  TriCount := 0;
 
  //Перебор всех возможных треугольников.
  for I := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for J := I + 1 to High(ArrDot) - 1 do begin
      for K := J + 1 to High(ArrDot) do begin
        //Очередной треугольник.
        Tri.A := ArrDot[I];
        Tri.B := ArrDot[J];
        Tri.C := ArrDot[K];
 
        //Проверяем не является ли треугольник вырожденным в отрезок.
        if IsDegTri(Tri) then Continue;
 
        //Проверяем: не пересекается ли текущий треугольник с теми треугольниками,
        //которые уже записаны в массив непересекающихся треугольников.
        if CrossArrTri(Tri, ArrTri, TriCount) then Continue;
 
        //Подсчитываем очередной найденный треугольник.
        Inc(TriCount);
 
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTri) < TriCount then begin
          SetLength(ArrTri, Length(ArrTri) + Capacity);
        end;
        //Добавляем треугольник в массив.
        ArrTri[TriCount - 1] := Tri;
 
      end;
    end
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTri, TriCount);
 
  //Теперь иы имеем массив непересекающихся треугольников.
 
  //Чертим найденные треугольники на канве.
 
  //Будем рисовать треугольники синим цветом.
  Image1.Canvas.Pen.Color := RGB(0, 0, 255);
  //Рисуем массив треугольников на канве компонента Image1.
  DrawArrTri(Image1.Canvas, Image1.Width div N, ArrTri);
 
  //Печатаем сведения о непересекающихся треугольниках.
 
  Memo1.Lines.Add( 'Всего непересекающихся треугольников: ' + IntToStr(Length(ArrTri)) );
  Memo1.Lines.Add( 'Координаты непересекающихся треугольников:');
  for I := 0 to High(ArrTri) do begin
    Memo1.Lines.Add(
      'Треугольник: (' + IntToStr(ArrTri[I].A.X) + ', ' + IntToStr(ArrTri[I].A.Y) + ')'
      + '; (' + IntToStr(ArrTri[I].B.X) + ', ' + IntToStr(ArrTri[I].B.Y) + ')'
      + '; (' + IntToStr(ArrTri[I].C.X) + ', ' + IntToStr(ArrTri[I].C.Y) + ')'
    );
  end;
 
end;
 
procedure TForm1.BtnClearMemoClick(Sender: TObject);
begin
  Memo1.Clear;
end;
 
procedure TForm1.BtnClearCnvClick(Sender: TObject);
begin
  Image1.Canvas.FillRect(Image1.ClientRect);
end;
 
end.

...
  N := StrToIntDef(Edit1.Text, 0);
  if (N < 2) or (N > 10) then begin
    ShowMessage('Число N должно быть в диапазоне: 2..10. Повторите ввод.'); //Исправлено с 1..10 на 2..10.
    Exit;
  end;
...

...
  //Перебор всех возможных треугольников.
  for I := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for J := I + 1 to High(ArrDot) - 1 do begin
      for K := J + 1 to High(ArrDot) do begin
        //Очередной треугольник.
        Tri.A := ArrDot[I];
        Tri.B := ArrDot[J];
        Tri.C := ArrDot[K];
 
        //Проверяем не является ли треугольник вырожденным в отрезок.
        if IsDegTri(Tri) then Continue;
 
        //Проверяем: не пересекается ли текущий треугольник с теми треугольниками,
        //которые уже записаны в массив непересекающихся треугольников.
        if CrossArrTri(Tri, ArrTri, TriCount) then Continue;
 
        //Подсчитываем очередной найденный треугольник.
        Inc(TriCount);
 
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTri) < TriCount then begin
          SetLength(ArrTri, Length(ArrTri) + Capacity);
        end;
        //Добавляем треугольник в массив.
        ArrTri[TriCount - 1] := Tri;
 
      end;
    end
  end;
...

...
  //Перебор треугольников по "непересекающимся" последовательным тройкам точек.
  I := Low(ArrDot);
  while I <= High(ArrDot) - 1 - 1 do begin
    J := I + 1;
    K := J + 1;
    //Очередной треугольник.
    Tri.A := ArrDot[I];
    Tri.B := ArrDot[J];
    Tri.C := ArrDot[K];
 
    //Проверяем не является ли треугольник вырожденным в отрезок.
    if IsDegTri(Tri) then Continue;
 
    //Проверяем: не пересекается ли текущий треугольник с теми треугольниками,
    //которые уже записаны в массив непересекающихся треугольников.
    if CrossArrTri(Tri, ArrTri, TriCount) then Continue;
 
    //Подсчитываем очередной найденный треугольник.
    Inc(TriCount);
 
    //Если требуется, увеличиваем длину массива треугольников.
    if Length(ArrTri) < TriCount then begin
      SetLength(ArrTri, Length(ArrTri) + Capacity);
    end;
    //Добавляем треугольник в массив.
    ArrTri[TriCount - 1] := Tri;
 
    Inc(I, 3);
  end;
...

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    MemoRes: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    BtnClearMemo: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    BtnClearCnv: TButton;
    procedure Button1Click(Sender: TObject);
    procedure BtnClearMemoClick(Sender: TObject);
    procedure BtnClearCnvClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A         : TPoint;
    B         : TPoint;
    C         : TPoint;
  end;
 
  //Тип - линия (AB).
  TLine = record
    A         : TPoint;
    B         : TPoint;
  end;
 
  //Тип массива для хранения точек. Вид массива - динамический.
  TArrDot        = array of TPoint;
  //Тип массива для хранения треугольников. Вид массива - динамический.
  TArrTriangle   = array of TTriangle;
 
const
  //Значение радиана (в градусах):
  Radian         : Extended = 180 / Pi;
  //Точность сравнения длин отрезков. Расстояние между ближайшими соседними точками сетки,
  //взятое по оси Х или по оси Y равно 1.
  EpsilonLen     : Extended = 0.1;
  //Точность сравнения углов. В градусах.
  EpsilonAngle   : Extended = 0.001;
  //Точность сравнения параметров уравнений прямых.
  EpsilonKoef    : Extended = 0.001;
 
var
  Form1: TForm1;
 
implementation
 
uses Math;
 
{$R *.dfm}
 
//------------------------------------------------------------------------------
//Рисование на канве.
//------------------------------------------------------------------------------
 
//Рисует точку aDot на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawDot(aCanvas : TCanvas; aZoom : Integer; var aDot : TPoint);
begin
  aCanvas.MoveTo(aDot.X * aZoom - 1, aDot.Y * aZoom - 1);
  aCanvas.LineTo(aDot.X * aZoom + 1, aDot.Y * aZoom - 1);
  aCanvas.LineTo(aDot.X * aZoom + 1, aDot.Y * aZoom + 1);
  aCanvas.LineTo(aDot.X * aZoom - 1, aDot.Y * aZoom + 1);
  aCanvas.LineTo(aDot.X * aZoom - 1, aDot.Y * aZoom - 1);
end;
 
//Рисует на канве aCanvas массив точек.
//При прорисовке применяет масштаб aZoom.
procedure DrawArrDot(aCanvas : TCanvas; aZoom : Integer; var aArrDot : TArrDot);
var
  i : Integer;
begin
  for i := 0 to High(aArrDot) do begin
    DrawDot(aCanvas, aZoom, aArrDot[i]);
  end;
end;
 
//Рисует треугольник aTri на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawTri(aCanvas : TCanvas; aZoom : Integer; var aTri : TTriangle);
begin
  (*
  aCanvas.MoveTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.B.X) * aZoom, Pred(aTri.B.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.C.X) * aZoom, Pred(aTri.C.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
  //*)
  //(*
  aCanvas.MoveTo(aTri.A.X * aZoom, aTri.A.Y * aZoom);
  aCanvas.LineTo(aTri.B.X * aZoom, aTri.B.Y * aZoom);
  aCanvas.LineTo(aTri.C.X * aZoom, aTri.C.Y * aZoom);
  aCanvas.LineTo(aTri.A.X * aZoom, aTri.A.Y * aZoom);
  //*)
end;
 
//Рисует на канве aCanvas массив треугольников.
//При прорисовке применяет масштаб aZoom.
procedure DrawArrTri(aCanvas : TCanvas; aZoom : Integer; var aArrTri : TArrTriangle);
var
  i : Integer;
begin
  for i := 0 to High(aArrTri) do begin
    DrawTri(aCanvas, aZoom, aArrTri[i]);
  end;
end;
 
//------------------------------------------------------------------------------
//Вычисления.
//------------------------------------------------------------------------------
 
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (var aLine1, aLine2 : TLine) : Boolean;
var
  //Флаг, показыавющий параллелен ли отрезок оси Y.
  LineVert1,
  LineVert2       : Boolean;
 
  //Параметры уравнения прямой aLine1.
  K1, C1,
  //Параметры уравнения прямой aLine2.
  K2, C2          : Extended;
  //Координаты точки пересечения прямых aLine1 и aLine2.
  XCross, YCross  : Extended;
begin
 
  Result := False;
 
  //Будем использовать "уравнение прямой с уголовым коэффициентом":
  //Уравнение прямой aLine1: Y = K1*X + C1;
  //Уравнение прямой aLine2: Y = K2*X + C2;
  //Уравнение такого вида не определено в случае, когда прямая параллельна оси Y.
 
  //Провека наложения проекций отрезков на оси X и Y.
  //Если имеется наложение проекций по обеим осям, тогда пересечение отрезков возможно.
  //Если хотябы на одной из осей наложения не обнаружено - такие отрезки не могут пересекаться.
  if
    not (
      ( ( aLine1.A.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.A.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine1.B.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.B.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine2.A.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.A.X <= Max(aLine1.A.X, aLine1.B.X) ) )
      or ( ( aLine2.B.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.B.X <= Max(aLine1.A.X, aLine1.B.X) ) )
    )
  then begin
    Exit;
  end;
 
  //Параллельность отрезка aLine1 оси Y.
  LineVert1 := False;
  if aLine1.A.X = aLine1.B.X then begin
    LineVert1 := True;
  end;
 
  //Параллельность отрезка aLine2 оси Y.
  LineVert2 := False;
  if aLine2.A.X = aLine2.B.X then begin
    LineVert2 := True;
  end;
 
  //Параметры прямых.
 
  if not LineVert1 then begin
    //Параметры прямой aLine1.
    K1 := (aLine1.A.Y - aLine1.B.Y) / (aLine1.A.X - aLine1.B.X);
    C1 := aLine1.A.Y - K1 * aLine1.A.X;
  end;
 
  if not LineVert2 then begin
    //Параметры прямой aLine2.
    K2 := (aLine2.A.Y - aLine2.B.Y) / (aLine2.A.X - aLine2.B.X);
    C2 := aLine2.A.Y - K2 * aLine2.A.X;
  end;
 
  //Определение пересекаются ли отрезки.
 
  //Если хотябы один отрезок параллелен оси Y.
 
  //Оба отрезка параллельны оси Y.
  if LineVert1 and LineVert2 then begin
    Exit;
  end;
 
  if LineVert1 and (not LineVert2) then begin
    //Отрезок aLine1 параллелен оси Y, а отрезок aLine2 не параллелен оси Y.
 
    //Координаты точки пересечения прямых aLine1 и aLine2.
    XCross := aLine1.A.X;
    YCross := K2 * XCross + C2;
  end else if (not LineVert1) and LineVert2 then begin
    //Отрезок aLine2 параллелен оси Y, а отрезок aLine1 не параллелен оси Y.
 
    //Координаты точки пересечения прямых aLine1 и aLine2.
    XCross := aLine2.A.X;
    YCross := K1 * XCross + C1;
  end else begin
    //Отрезоки aLine1 и aLine2 непараллелены оси Y.
 
    //Если отрезки параллельны друг другу.
    if SameValue(K1, K2, EpsilonKoef) then begin
      Exit;
    end;
 
    //Отрезки непараллельны друг другу.
 
    XCross := (C1 - C2) / (K2 - K1);
    YCross := (K2 * C1 - K1 * C2) / (K2 - K1);
  end;
 
  //Наложение координат точки пересечения прямых на проекции отрезков.
  if
    not (
          ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
      and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
      and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
      and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
    )
  then begin
    //Координаты точки пересечения прямых не накладываются на все проекции
    //обоих отрезков.
    Exit;
  end;
 
  //Проверяем касаются ли отрезки.
  if
       ( SameValue(aLine1.A.X, XCross, EpsilonLen) and SameValue(aLine1.A.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine1.B.X, XCross, EpsilonLen) and SameValue(aLine1.B.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine2.A.X, XCross, EpsilonLen) and SameValue(aLine2.A.Y, YCross, EpsilonLen) )
    or ( SameValue(aLine2.B.X, XCross, EpsilonLen) and SameValue(aLine2.B.Y, YCross, EpsilonLen) )
  then begin
    Exit;
  end;
 
  Result := True;
end;
 
//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(var aA, aB, aC : TPoint) : Extended;
var
  LineBA    : Extended;
  LineBC    : Extended;
  LineAC    : Extended;
  CosABC    : Extended;
begin
 
  // Теорема косинусов:
  //AC^2 = BA^2 + BC^2 - 2*BA*BC*cosABC
  //-> cosABC = (AC^2 - BA^2 - BC^2)/2*BA*BC
  //-> ABC = ArcCos( cosABC ) - В радианах
  //-> ABC = ArcCos( cosABC ) * Radian - В градусах.
 
  LineBA := Sqrt( Sqr(aB.X - aA.X) + Sqr(aB.Y - aA.Y) );
  LineBC := Sqrt( Sqr(aB.X - aC.X) + Sqr(aB.Y - aC.Y) );
  LineAC := Sqrt( Sqr(aA.X - aC.X) + Sqr(aA.Y - aC.Y) );
 
  CosABC := ( - Sqr(LineAC) + Sqr(LineBA) + Sqr(LineBC) ) / ( 2 * LineBA * LineBC );
 
  //Так как функция ArcCos(CosABC) не определена для аргументов CosABC > 1 и CosABC < -1, а при
  //вычисленях с плавающей точкой возможны небольшие "заскоки" за область допустимых значений, то
  //такие случаи предусмотрим в коде.
  if CosABC > 1 then begin
    CosABC := 1;
  end else if CosABC < -1 then begin
    CosABC := -1;
  end;
 
  Result := Radian * ArcCos(CosABC);
 
end;
 
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(var aTri : TTriangle; var aDot : TPoint) : Boolean;
begin
  //Если точка D расположена внутри треугольника ABC, то выполнятся следующие 3 условия:
  //1. Углы: ABD + CBD = ABC
  //2. Углы: ACD + BCD = ACB
  //3. Углы: BAD + CAD = BAC
  //Если точка D расположена вне треугольника ABC, то какие-то два из трёх приведенных
  //выше условий будут нарушены таким образом:
  //1. Углы: ABD + CBD > ABC
  //2. Углы: ACD + BCD > ACB
  //3. Углы: BAD + CAD > BAC
  //Если при последовательной проверке трёх обнаружено первое нарушение -
  //это однозначно говорит о том, что точка D лежит за пределами треугольника ABC.
  //На этом и построим алгоритм.
  //
  //                     <A>
  //                     /|\
  //                    / | \
  //                   /  |  \
  //                  /   |   \
  //                 /    |    \
  //                /    <D>    \
  //               /   /     \   \
  //              /  /         \  \
  //             / /             \ \
  //            //                 \\
  //          <B>-------------------<C>
 
  Result := False;
 
  //Углы ABD, AСD, BAD неопределены, в случае, если точка D совпадает с любой
  //из вершин треугольника ABC. Поэтому предусмотрим этот случай.
  if
    ( (aTri.A.X = aDot.X) and (aTri.A.Y = aDot.Y) )
    or ( (aTri.B.X = aDot.X) and (aTri.B.Y = aDot.Y) )
    or ( (aTri.C.X = aDot.X) and (aTri.C.Y = aDot.Y) )
  then begin
    Result := True;
    Exit;
  end;
 
  //1. Если углы: ABD + CBD > ABC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.B, aDot) + GetAngleABC(aTri.C, aTri.B, aDot)
      - GetAngleABC(aTri.A, aTri.B, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //2. Если углы: ACD + BCD > ACB -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.C, aDot) + GetAngleABC(aTri.B, aTri.C, aDot)
      - GetAngleABC(aTri.A, aTri.C, aTri.B)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //3. Если углы: BAD + CAD > BAC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.B, aTri.A, aDot) + GetAngleABC(aTri.C, aTri.A, aDot)
      - GetAngleABC(aTri.B, aTri.A, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //4. Точка D лежит внутри треугольника.
 
  Result := True;
end;
 
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(var aTri1, aTri2 : TTriangle) : Boolean;
var
  Line1, Line2       : TLine;
begin
  Result := True;
 
  //(*Отладка
  //(1, 1); (1, 2); (2, 1)
  //(1, 1); (2, 6); (6, 1)
  if
    //(aTri1.A.X = 1) and (aTri1.A.Y = 1) and (aTri1.B.X = 1) and (aTri1.B.Y = 2) and (aTri1.C.X = 2) and (aTri1.C.Y = 1)
    (aTri2.A.X = 1) and (aTri2.A.Y = 1) and (aTri2.B.X = 2) and (aTri2.B.Y = 6) and (aTri2.C.X = 6) and (aTri2.C.Y = 1)
  then begin
    Line1 := Line2;
  end;
  //*)
 
  //Пересекается ли сторона AB треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.A;
  Line1.B := aTri1.B;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона BC треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.B;
  Line1.B := aTri1.C;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона CA треугольника aTri1 с любой из сторон треугольника aTri2
 
  Line1.A := aTri1.C;
  Line1.B := aTri1.A;
 
  Line2.A := aTri2.A;
  Line2.B := aTri2.B;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.B;
  Line2.B := aTri2.C;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  Line2.A := aTri2.C;
  Line2.B := aTri2.A;
  if CrossLine(Line1, Line2) then begin
    Exit;
  end;
 
  //В этой точке алгоритма мы знаем, что стороны треугольников не пересекаются.
  //Теперь проверяем не лежит ли один треугольник полностью внутри другого.
  //Если один треугольник полностью лежит внутри другого, это означает, что все
  //вершины этого треугольника тоже лежат внутри другого.
  //Если один треугольник полностью лежит внутри другого, то будем считать, что
  //такие треугольники пересекаются.
 
  //Расположен ли треугольник aTri2 внутри треугольника aTri1.
  if
    DotInTriangle(aTri1, aTri2.A)
    and DotInTriangle(aTri1, aTri2.B)
    and DotInTriangle(aTri1, aTri2.C)
  then begin
    Exit;
  end;
 
  //Расположен ли треугольник aTri1 внутри треугольника aTri2.
  if
    DotInTriangle(aTri2, aTri1.A)
    and DotInTriangle(aTri2, aTri1.B)
    and DotInTriangle(aTri2, aTri1.C)
  then begin
    Exit;
  end;
 
  Result := False;
end;
 
//Проверяет: пересекается ли треугольник aTri хотябы с одним треугольником
//из массива aArrTri.
function CrossArrTri(var aTri : TTriangle; const aArrTri : TArrTriangle;
  var aTriCount : Integer) : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := 0 to aTriCount - 1 do begin
    Result := CrossTriangle(aTri, aArrTri[i]);
    if Result then Exit;
  end;
end;
 
//Проверяет: не является ли треугольник aTri вырожденным в отрезок.
//True - является вырожденным в отрезок.
//False - не является вырожденным в отрезок.
function IsDegTri(var aTri : TTriangle) : Boolean;
begin
  Result := True;
 
  //Вершины треугольника не должны совпадать.
  if
    ( (aTri.A.X = aTri.B.X) and (aTri.A.Y = aTri.B.Y) )
    or ( (aTri.A.X = aTri.C.X) and (aTri.A.Y = aTri.C.Y) )
    or ( (aTri.B.X = aTri.C.X) and (aTri.B.Y = aTri.C.Y) )
  then begin
    Exit;
  end;
 
  if GetAngleABC(aTri.A, aTri.B, aTri.C) < EpsilonAngle then Exit;
  if Abs( GetAngleABC(aTri.A, aTri.B, aTri.C) - 180 ) < EpsilonAngle then Exit;
 
  Result := False;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity = 100;
var
  N             : Integer;
  //Массив исходных точек.
  ArrDot        : TArrDot;
  //Массив непересекающихся треугольников.
  ArrTri        : TArrTriangle;
 
  //Количество непересекающихся треугольников.
  TriCount      : Integer;
  //Треугольник.
  Tri           : TTriangle;
  //Счётчики для циклов.
  I, J, K       : Integer;
  //Координаты точки.
  X, Y          : Integer;
begin
 
  N := StrToIntDef(Edit1.Text, 0);
  if (N < 3) or (N > 400) then begin
    ShowMessage('Число N должно быть в диапазоне: 3..400. Повторите ввод.');
    Exit;
  end;
 
  //Очистка канвы и Мемо.
  Image1.Canvas.FillRect(Image1.ClientRect);
  MemoRes.Clear;
 
  //Подготовка исходных данных для задачи.
 
  SetLength(ArrDot, N);
 
  //Формируем массив точек.
  Randomize;
  for I := Low(ArrDot) to High(ArrDot) do begin
    ArrDot[I].X := Random(101);
    ArrDot[I].Y := Random(101);
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Поиск непересекающихся треугольников.
 
  //Если массив треугольников не пустой, то обнуляем его
  SetLength(ArrTri, 0);
  TriCount := 0;
 
  //Зелёный цвет пера. - Этим цветом рисуем исходное множество треугольников.
  Image1.Canvas.Pen.Color := RGB(0, 255, 0);
 
  //Перебор треугольников по "непересекающимся" последовательным тройкам точек.
  I := Low(ArrDot);
  while I <= High(ArrDot) - 1 - 1 do begin
    J := I + 1;
    K := J + 1;
    //Очередной треугольник.
    Tri.A := ArrDot[I];
    Tri.B := ArrDot[J];
    Tri.C := ArrDot[K];
 
    //Рисуем треугольник на канве компонента Image1.
    DrawTri(Image1.Canvas, Image1.Width div 100, Tri);
 
    //Проверяем не является ли треугольник вырожденным в отрезок.
    if IsDegTri(Tri) then begin
      Inc(I, 3);
      Continue;
    end;
 
    //Проверяем: не пересекается ли текущий треугольник с теми треугольниками,
    //которые уже записаны в массив непересекающихся треугольников.
    if CrossArrTri(Tri, ArrTri, TriCount) then begin
      Inc(I, 3);
      Continue;
    end;
 
    //Подсчитываем очередной найденный треугольник.
    Inc(TriCount);
 
    //Если требуется, увеличиваем длину массива треугольников.
    if Length(ArrTri) < TriCount then begin
      SetLength(ArrTri, Length(ArrTri) + Capacity);
    end;
    //Добавляем треугольник в массив.
    ArrTri[TriCount - 1] := Tri;
 
    Inc(I, 3);
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTri, TriCount);
 
  //Теперь иы имеем массив непересекающихся треугольников.
 
  //Рисуем точки на канве.
 
  //Красный цвет пера.
  Image1.Canvas.Pen.Color := RGB(255, 0, 0);
  //Рисуем массив точек на канве компонента Image1.
  DrawArrDot(Image1.Canvas, Image1.Width div 100, ArrDot);
 
  //Рисуем найденные непересекающиеся треугольники на канве.
 
  //Синий цвет пера.
  Image1.Canvas.Pen.Color := RGB(0, 0, 255);
  //Рисуем массив треугольников на канве компонента Image1.
  DrawArrTri(Image1.Canvas, Image1.Width div 100, ArrTri);
 
  //Печатаем сведения о непересекающихся треугольниках.
 
  MemoRes.Lines.Add( 'Всего непересекающихся треугольников: ' + IntToStr(Length(ArrTri)) );
  MemoRes.Lines.Add( 'Координаты непересекающихся треугольников:');
  for I := 0 to High(ArrTri) do begin
    MemoRes.Lines.Add(
      'Треугольник: (' + IntToStr(ArrTri[I].A.X) + ', ' + IntToStr(ArrTri[I].A.Y) + ')'
      + '; (' + IntToStr(ArrTri[I].B.X) + ', ' + IntToStr(ArrTri[I].B.Y) + ')'
      + '; (' + IntToStr(ArrTri[I].C.X) + ', ' + IntToStr(ArrTri[I].C.Y) + ')'
    );
  end;
 
end;
 
procedure TForm1.BtnClearMemoClick(Sender: TObject);
begin
  MemoRes.Clear;
end;
 
procedure TForm1.BtnClearCnvClick(Sender: TObject);
begin
  Image1.Canvas.FillRect(Image1.ClientRect);
end;
 
end.