Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами в заданном множестве точек на плоскости.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A    : TPoint;
    B    : TPoint;
    C    : TPoint;
    //Длина основания.
    Base : Extended;
  end;
 
  //Тип массива для хранения треугольников. Вид массива - динамический.
  TArrTriangle = array of TTriangle;
 
const
  //Размер квадратной матрицы - 20x20 точек.
  N = 20;
  //Точность сравнения длин отрезков. Расстояние между ближайшими соседними точками сетки,
  //взятое по оси Х или по оси Y равно 1.
  EpsilonLen : Extended = 0.2;
 
var
  Form1: TForm1;
 
  //Массив равносторонних треугольников.
  ArrTri   : TArrTriangle;
 
implementation
 
{$R *.dfm}
 
//Рисование на канве.
 
//Очистка канвы (заливка её белым цветом).
procedure ClearCanvas(const aImage : TImage);
var
  //Квадрат обрамляющий канву компонента aImage.
  Rect : TRect;
begin
  Rect.Top := 0;
  Rect.Left := 0;
  Rect.Bottom := aImage.Height;
  Rect.Right := aImage.Width;
  aImage.Canvas.Brush.Color := RGB(255, 255, 255);
  aImage.Canvas.FillRect(Rect);
end;
 
//Рисует треугольник aTri на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawTri(const aCanvas : TCanvas; const aZoom : Integer; const 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(const aCanvas : TCanvas; const aZoom : Integer; const aArrTri : TArrTriangle);
var
  i : Integer;
begin
  for i := Low(aArrTri) to High(aArrTri) do begin
    DrawTri(aCanvas, aZoom, aArrTri[i]);
  end;
end;
 
//Вычисления.
 
//Эта функция определяет: является ли треугольник равносторонним.
//Если треугольник оказался равносторонним, то вычисляет длину его основания.
function IsEqualSideTri(var aTri : TTriangle) : Boolean;
var
  //Разность координат двух точек.
  DX,
  DY        : Integer;
  //Длины сторон треугольника.
  LengthAB,
  LengthBC,
  LengthCA  : Extended;
begin
 
  Result := False;
 
  //Сторона AB.
  DX := abs(aTri.A.X - aTri.B.X);
  DY := abs(aTri.A.Y - aTri.B.Y);
  LengthAB := Sqrt(DX * DX + DY * DY);
 
  //Сторона BC.
  DX := abs(aTri.B.X - aTri.C.X);
  DY := abs(aTri.B.Y - aTri.C.Y);
  LengthBC := Sqrt(DX * DX + DY * DY);
 
  //Сторона CA.
  DX := abs(aTri.C.X - aTri.A.X);
  DY := abs(aTri.C.Y - aTri.A.Y);
  LengthCA := Sqrt(DX * DX + DY * DY);
 
  if
    ( Abs(LengthAB - LengthBC) < EpsilonLen )
    and ( Abs(LengthBC - LengthCA) < EpsilonLen )
  then begin
    //Длина основания у равностороннего треугольника равна длине любой его стороны.
    aTri.Base := LengthAB;
    Result := True;
  end;
 
end;
 
//Проверяет, есть ли в массиве треугольников треугольник с таким же основанием.
//На массив треугольников ссылается указатель aPArrTri.
function IsPresent(const aArrTri : TArrTriangle; const aTri : TTriangle; const aTriCount : Integer) : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := 0 to aTriCount - 1 do begin
    if
      ( Abs(aArrTri[i].Base - aTri.Base) < EpsilonLen )
 
      or ( ( aTri.A.X = aArrTri[i].A.X ) and ( aTri.A.Y = aArrTri[i].A.Y ) )
      or ( ( aTri.A.X = aArrTri[i].B.X ) and ( aTri.A.Y = aArrTri[i].B.Y ) )
      or ( ( aTri.A.X = aArrTri[i].C.X ) and ( aTri.A.Y = aArrTri[i].C.Y ) )
 
      or ( ( aTri.B.X = aArrTri[i].A.X ) and ( aTri.B.Y = aArrTri[i].A.Y ) )
      or ( ( aTri.B.X = aArrTri[i].B.X ) and ( aTri.B.Y = aArrTri[i].B.Y ) )
      or ( ( aTri.B.X = aArrTri[i].C.X ) and ( aTri.B.Y = aArrTri[i].C.Y ) )
 
      or ( ( aTri.C.X = aArrTri[i].A.X ) and ( aTri.C.Y = aArrTri[i].A.Y ) )
      or ( ( aTri.C.X = aArrTri[i].B.X ) and ( aTri.C.Y = aArrTri[i].B.Y ) )
      or ( ( aTri.C.X = aArrTri[i].C.X ) and ( aTri.C.Y = aArrTri[i].C.Y ) )
    then begin
      Result := True;
      Break;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity       : Integer = 100;
var
  //Массив исходных точек.
  ArrDot         : array[1..N * N] of TPoint;
  //Количество равносторонних треугольников.
  TriCount       : Integer;
  //Треугольник.
  Tri            : TTriangle;
  //Счетчики для циклов.
  i, j, k        : Integer;
  //Координаты точки.
  X, Y           : Integer;
begin
 
  //Подготовка исходных данных для задачи.
 
  //Квадратная сетка из точек: 20х20. Выглядит так:
 
  //     1   2   3   4   5   6   7   8   9   10  ...  19  20
  //  1  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  2  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  3  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  4  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  5  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  6  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  7  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  8  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  9  .   .   .   .   .   .   .   .   .   .        .   .
 
  // 10  .   .   .   .   .   .   .   .   .   .        .   .
 
  // ...
 
  // 19  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  // 20  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  //Формируем массив этих точек.
  i := 0;
  for X := 1 to N do begin
    for Y := 1 to N do begin
      ArrDot[i].X := X;
      ArrDot[i].Y := Y;
      Inc(i);
    end;
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Решение задачи. - Поиск равносторонних треугольников с различными основаниями
  //и с несовпадающими вершинами.
 
  //Обнуляем массив треугольников.
  Finalize(ArrTri);
  //Количество найденных треугольников пока равно нулю.
  TriCount := 0;
 
  //Перебираем все возможные треугольники.
  for i := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for j := i + 1 to High(ArrDot) do begin
      for k := j + 1 to High(ArrDot) do begin
        //Очередной треугольник.
        Tri.A := ArrDot[i];
        Tri.B := ArrDot[j];
        Tri.C := ArrDot[k];
        Tri.Base := -1;
        //Проверяем, является ли очередной треугольник равносторонним.
        //Одновременно вычисляем длину основания треугольника.
        if not IsEqualSideTri(Tri) then begin
          Continue;
        end;
        //Проверяем, нет ли треугольника с таким же по длине основанием
        //или с совпадающими вершинами в массиве треугольников.
        if IsPresent(ArrTri, Tri, TriCount) then begin
          Continue;
        end;
 
        //Подсчитываем очередной найденный равносторонний треугольник.
        Inc(TriCount);
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTri) <= TriCount then begin
          SetLength(ArrTri, Length(ArrTri) + Capacity);
        end;
        //Добавляем равносторонний треугольник в массив.
        ArrTri[TriCount - 1] := Tri;
      end;
    end
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTri, TriCount);
 
  //Теперь иы имеем массив равносторонних треугольников с уникальными длинами оснований
  //и с несовпадающими вершинами.
 
  //Прорисовка.
 
  //Очистка канвы.
  ClearCanvas(Image1);
  //Для прорисовки треугольников на канве, задаём синий цвет пера.
  Image1.Canvas.Pen.Color := RGB(0, 0, 255);
  //Рисуем массив треугольников на канве компонента Image1.
  DrawArrTri(Image1.Canvas, Image1.Width div N, ArrTri);
 
  //Печать сведений о треугольниках.
  Memo1.Clear;
  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.Button2Click(Sender: TObject);
begin
  //Очистка канвы.
  ClearCanvas(Image1);
  //Очистка Мемо.
  Memo1.Clear;
end;
 
end.