Подсчитать количество равносторонних треугольников с вершинами в заданном множестве точек на плоскости (Delphi)

[dea_celeste]

Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами в заданном множестве точек на плоскости и определить пересекаются ли они.
В соответствии с требованиями моего вуза, у меня написан основной код задачи, а вот математическая часть задачи не написана. То есть нет решения связанного с пересечением треугольников и выводом на экран изображения с этими треугольниками

[evg_m]

а вот математическая часть задачи не написана.

Вы это имели ввиду?

математическая часть (кратко)
пересечение треугольников = пересечение их сторон
(отрезков)
отдельно при необходимости надо рассматривать случай полного вхождения одного треугольника в другой.

пересечение отрезков = пересечение прямых на заданных интервалах.

пересечение прямых = система двух уравнений прямой (проходящей через заданные точки) имеет решение.

система из двух уравнений (прямые проходящие через вершины треугольника)
и ограничениями по диапазону (принадлежность отрезку)
имеет решение
-> отрезки пересекаются
-> стороны треугольников пересекаются.

[dea_celeste]

Собственно говоря да... я понимаю как это математически, а как это записать в код, не особо, наверное потому что давно не писала на делфи...
Вся программа в архиве, а тут маленькая ее часть по треугольникам из того что я попыталась написать...
тут конечно есть какие-то наработки по решению пересечения треугольников, но мне кажется должно быть как-то по -другому... я не все понимаю, к сожалению... знаю звучит уныло, но это так

procedure triygolnic;
 var
  i,j,k:Integer; a, b, c: real; fl:Boolean;
 begin

  fl:=false;
Reset(f);
      for i:=0 to high(mas) do
      for j:=0 to high(mas2) do
      for k:=0 to high(mas3) do
     if (i<>j) and (i<>k) and (j<>k) and (mas[i,0]<>mas2[j,0])
     and (mas[i,0]<>mas3[k,0]) and (mas2[j,0]<>mas3[k,0])
     and (mas[i,1]<>mas2[j,1]) and (mas2[j,1]<>mas3[k,1])
     and (mas[i,1]<>mas3[k,1]) then
    begin
     c:=Sqrt(Sqr(mas[i,1]-mas2[j,1])+sqr(mas[i,0]-mas2[j,0]));
     a:=Sqrt(Sqr(mas2[j,1]-mas3[k,1])+sqr(mas2[j,0]-mas3[k,0]));
     b:=Sqrt(Sqr(mas[i,1]-mas3[k,1])+sqr(mas[i,0]-mas3[k,0]));
      if((a-b)<0.2)and((b-c)<0.2)and((c-a)<0.2) then
       begin
        x1:=mas[i,0];
        x2:=mas2[j,0];
        x3:=mas3[k,0];
        y1:=mas[i,1];
        y2:=mas2[j,1];
        y3:=mas3[k,1];

     end;
    end;

end;
function CrossLines(X1,Y1,X2,Y2, X3,Y3,X4,Y4: Integer): Boolean;
begin
  Result := (((X3-X1)*(Y2-Y1) - (Y3-Y1)*(X2-X1)) *
   ((X4-X1)*(Y2-Y1) - (Y4-Y1)*(X2-X1)) <= 0)
   and
   (((X1-X3)*(Y4-Y3) - (Y1-Y3)*(X4-X3)) *
   ((X2-X3)*(Y4-Y3) - (Y2-Y3)*(X4-X3)) <= 0)
   and (projection_cross(X1,X2,X3,X4)and projection_cross(Y1,Y2,Y3,Y4))
end;
  function projection_cross(a, b, c, d: Integer): Boolean;
begin
         Result :=((max(c,d)>=min(a,b)) and (min(c,d)<=max(a,b))) return true;
end;

[denisbrain]

Сообщение от dea_celeste

Собственно говоря да... я понимаю как это математически, а как это записать в код, не особо, наверное потому что давно не писала на делфи...
Вся программа в архиве, а тут маленькая ее часть по треугольникам из того что я попыталась написать...
тут конечно есть какие-то наработки по решению пересечения треугольников, но мне кажется должно быть как-то по -другому... я не все понимаю, к сожалению... знаю звучит уныло, но это так

procedure triygolnic;
 var
  i,j,k:Integer; a, b, c: real; fl:Boolean;
 begin

  fl:=false;
Reset(f);
      for i:=0 to high(mas) do
      for j:=0 to high(mas2) do
      for k:=0 to high(mas3) do
     if (i<>j) and (i<>k) and (j<>k) and (mas[i,0]<>mas2[j,0])
     and (mas[i,0]<>mas3[k,0]) and (mas2[j,0]<>mas3[k,0])
     and (mas[i,1]<>mas2[j,1]) and (mas2[j,1]<>mas3[k,1])
     and (mas[i,1]<>mas3[k,1]) then
    begin
     c:=Sqrt(Sqr(mas[i,1]-mas2[j,1])+sqr(mas[i,0]-mas2[j,0]));
     a:=Sqrt(Sqr(mas2[j,1]-mas3[k,1])+sqr(mas2[j,0]-mas3[k,0]));
     b:=Sqrt(Sqr(mas[i,1]-mas3[k,1])+sqr(mas[i,0]-mas3[k,0]));
      if((a-b)<0.2)and((b-c)<0.2)and((c-a)<0.2) then
       begin
        x1:=mas[i,0];
        x2:=mas2[j,0];
        x3:=mas3[k,0];
        y1:=mas[i,1];
        y2:=mas2[j,1];
        y3:=mas3[k,1];

     end;
    end;

end;
function CrossLines(X1,Y1,X2,Y2, X3,Y3,X4,Y4: Integer): Boolean;
begin
  Result := (((X3-X1)*(Y2-Y1) - (Y3-Y1)*(X2-X1)) *
   ((X4-X1)*(Y2-Y1) - (Y4-Y1)*(X2-X1)) <= 0)
   and
   (((X1-X3)*(Y4-Y3) - (Y1-Y3)*(X4-X3)) *
   ((X2-X3)*(Y4-Y3) - (Y2-Y3)*(X4-X3)) <= 0)
   and (projection_cross(X1,X2,X3,X4)and projection_cross(Y1,Y2,Y3,Y4))
end;
  function projection_cross(a, b, c, d: Integer): Boolean;
begin
         Result :=((max(c,d)>=min(a,b)) and (min(c,d)<=max(a,b))) return true;
end;

так программа корректно работает?

Function Dlina(a,b:Tpoint):real; // находим расстояние между двумя точками
var x1,y1,x2,y2:real;
begin
x1:=a.x;
y1:=a.y;
x2:=b.x;
y2:=b.y;
   result:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))
end;


function Subtract(AVec1, AVec2 : TPoint) : TPoint;
begin
  Result.X := AVec1.X - AVec2.X;
  Result.Y := AVec1.Y - AVec2.Y;
end;
// пересекаются ли отрезки 
function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TPoint) : boolean;
Var
  diffLA, diffLB : TPoint;
  CompareA, CompareB : integer;
begin
  Result := False;
  diffLA := Subtract(LineAP2, LineAP1);
  diffLB := Subtract(LineBP2, LineBP1);
  CompareA := diffLA.X*LineAP1.Y - diffLA.Y*LineAP1.X;
  CompareB := diffLB.X*LineBP1.Y - diffLB.Y*LineBP1.X;
  if ( ((diffLA.X*LineBP1.Y - diffLA.Y*LineBP1.X) < CompareA) xor
       ((diffLA.X*LineBP2.Y - diffLA.Y*LineBP2.X) < CompareA) ) and
     ( ((diffLB.X*LineAP1.Y - diffLB.Y*LineAP1.X) < CompareB) xor
       ((diffLB.X*LineAP2.Y - diffLB.Y*LineAP2.X) < CompareB) ) then
    Result := True;
end;

[dea_celeste]

Честно говоря, нет.... процедура эта не работает, ну не делает как надо.. у меня всегда были проблемы с графикой в делфи... Поэтому я и прошу помощи здесь... Чтобы мне объяснили как и что должно быть чтобы работало правильно..