• Паскаль. Два треугольника заданы координатами вершин. Определить, подобны ли эти треугольники.

Ответы 1

  • // PascalABC.NET 3.0, сборка 1076type  Point=record  x,y:real  end;  Line=record  A,B:Point  end;  Triangle=record  A,B,C:Point;  sa,sb,sc:real; { длины сторон }  end;procedure GetPoint(PointName:char; var M:Point);begin  Write('Введите координаты точки ',PointName,'(x,y): ');  Read(M.x,M.y)end;function LineLength(A,B:Point):real;begin  LineLength:=sqrt(sqr(B.x-A.x)+sqr(B.y-A.y))end;  procedure CreateTriangle(var T:Triangle; var l:boolean);begin  With T do begin    GetPoint('A',A);    GetPoint('B',B);    GetPoint('C',C);    sa:=LineLength(B,C);    sb:=LineLength(A,C);    sc:=LineLength(A,B);    l:=(sa+sb>sc) and (sa+sc>sb) and (sb+sc>sa)  endend;function TriangleIsLikes(T1,T2:Triangle):boolean;var  k1,k2,k3:real;begin  k1:=T1.sa/T2.sa; k2:=T1.sb/T2.sb;  if k1=k2 then begin    k3:=T1.sc/T2.sc;    TriangleIsLikes:=k1=k3    end  else    TriangleIsLikes:=Falseend;var  T1,T2:Triangle;  legal:boolean;begin  Writeln('*** Первый треугольник ***');  CreateTriangle(T1,legal);  if legal then begin    Writeln('*** Второй треугольник ***');    CreateTriangle(T2,legal);    if legal then      if TriangleIsLikes(T1,T2) then Writeln('Треугольники подобны')      else Writeln('Треугольники не подобны')    else Writeln('Треугольник невозможно построить')    end  else Writeln('Треугольник невозможно построить')end.
  • Добавить свой ответ

Войти через Google

или

Забыли пароль?

У меня нет аккаунта, я хочу Зарегистрироваться

How much to ban the user?
1 hour 1 day 100 years