Правила форума
Прочтите прежде чем задавать вопрос!
Если в треугольнике есть такая вершина, что прямая проведенная через нее и заданную точку не пересекает сторону треугольника, противоположную этой вершине, то заданная точка находится вне треугольника.
О найденных ошибках сообщайте сюда: Собираем Ошибки!
uses crt;
const
eps = 0.00001;
type
tfloat = extended;
tpoint = record
x, y: tfloat;
end;
tline = record
p1, p2: tpoint;
k, b : tfloat;
end;
ttriangle = record
top: array [1..3] of tpoint;
end;
{
функция вернет true, если координаты точе p1 и p2 совпадают
}
function points_equal(const p1, p2: tpoint): boolean;
begin
points_equal := (abs(p1.x - p2.x) < eps) and (abs(p1.y - p2.y) < eps)
end;
{
получаем уравнение вида y = k*x+b для прямой по двум точкам,
случаи если прямая параллельна одной из осей, в программе рассматриваются отдельно
}
procedure get_line_equation(var line: tline; const point1, point2: tpoint);
begin
with line do begin
p1.x := point1.x; p1.y := point1.y;
p2.x := point2.x; p2.y := point2.y;
if not((p1.x = p2.x) or (p1.y = p2.y)) then begin
k := (p2.y - p1.y) / (p2.x - p1.x);
b := -p1.x * ((p2.y - p1.y) / (p2.x - p1.x)) + p1.y;
end else begin
k := 0;
b := 0;
end;
end;
end;
{
значение функции заданной прямой line в точке x
}
function get_equation_value(const line: tline; const x: tfloat): tfloat;
begin
get_equation_value := line.k * x + line.b;
end;
{
функция вернет true, если значение value находится между значений A и B
}
function value_between(const value: tfloat; const a, b: tfloat): boolean;
begin
value_between :=
((value >= a) and (value <= b)) or ((value >= b) and (value <= a));
end;
{
функция вернет true, если точка point принадлежит прямой line (не отрезку)
}
function in_line(const point: tpoint; const line: tline): boolean;
begin
with line do begin
if (p1.x = p2.x) then in_line := point.x = p1.x
else if (p1.y = p2.y) then in_line := point.y = p1.y
else in_line := abs(point.y - get_equation_value(line, point.x)) < eps;
end;
end;
{
функция вернет true, если точка point принадлежит отрезку прямой line
крайние точки отрезка line1.p1 и line2.p2
}
function in_piece_line(const point: tpoint; const line: tline): boolean;
var
belongs: boolean;
begin
belongs := in_line(point, line);
if belongs then with line do begin
if abs(p1.x - p2.x) < eps then belongs := belongs and value_between(point.y, p1.y, p2.y)
else belongs := value_between(point.x, p1.x, p2.x)
end;
in_piece_line := belongs;
end;
{
если у прямых line1 и line2 есть точка пересечения, то функция вернет true и cross_point будет
содержать ее координаты
}
function get_crossing_point(const line1, line2: tline;
var cross_point: tpoint): boolean;
begin
if ((abs(line1.p1.x - line1.p2.x) < eps) and (abs(line2.p1.x - line2.p2.x) < eps))
or((abs(line1.p1.y - line1.p2.y) < eps) and (abs(line2.p1.y - line2.p2.y) < eps))
then get_crossing_point := false
else begin
get_crossing_point := true;
if (line1.p1.x = line1.p2.x) then begin
if (line2.p1.y = line2.p2.y) then begin
cross_point.x := line1.p1.x;
cross_point.y := line2.p1.y;
end else begin
cross_point.x := line1.p1.x;
cross_point.y := get_equation_value(line2, cross_point.x);
end;
end else if (line1.p1.y = line1.p2.y) then begin
if (line2.p1.x = line2.p2.x) then begin
cross_point.x := line2.p1.x;
cross_point.y := line1.p1.y;
end else begin
cross_point.y := line1.p1.y;
cross_point.x := (cross_point.y - line2.b) / line2.k;
end;
//
end else if (line2.p1.x = line2.p2.x) then begin
if (line1.p1.y = line1.p2.y) then begin
cross_point.x := line2.p1.x;
cross_point.y := line1.p1.y;
end else begin
cross_point.x := line2.p1.x;
cross_point.y := get_equation_value(line1, cross_point.x);
end;
end else if (line2.p1.y = line2.p2.y) then begin
if (line1.p1.x = line1.p2.x) then begin
cross_point.x := line1.p1.x;
cross_point.y := line2.p1.y;
end else begin
cross_point.y := line2.p1.y;
cross_point.x := (cross_point.y - line1.b) / line1.k;
end;
end else begin
cross_point.x := (line2.b - line1.b) / (line1.k - line2.k);
cross_point.y := get_equation_value(line1, cross_point.x);
end;
end;
end;
{
функция вернет true, если точка point находится в треугольнике triangle
}
function point_in_triangle(const point: tpoint;
const triangle: ttriangle): boolean;
var
test_line, check_side: tline;
cross_point: tpoint;
i, j: integer;
_include: boolean;
begin
i := 1;
_include := false;
while (i <= 2) and not(_include) do begin
j := i + 1;
while (j <= 3) and not(_include) do begin
get_line_equation(test_line, triangle.top[i], triangle.top[j]);
_include := in_piece_line(point, test_line);
inc(j);
end;
inc(i);
end;
if not(_include) then begin
_include := true;
i := 1;
while (i <= 3) and _include do begin
get_line_equation(test_line, triangle.top[i], point);
case i of
1: get_line_equation(check_side, triangle.top[2], triangle.top[3]);
2: get_line_equation(check_side, triangle.top[1], triangle.top[3]);
3: get_line_equation(check_side, triangle.top[1], triangle.top[2]);
end;
_include := get_crossing_point(test_line, check_side, cross_point)
and (in_piece_line(cross_point, check_side));
inc(i);
end;
end;
point_in_triangle := _include;
end;
{
функция вернет true, если треугольник t_1 находится в треугольнике t_2
}
function triangle_in_triangle(const t_1, t_2: ttriangle): boolean;
var
i: byte;
begin
i := 1;
while (i <= 3) and point_in_triangle(t_1.top[i], t_2) do inc(i);
triangle_in_triangle := (i > 3);
end;
var
cross_point: tpoint;
t: array [1..2] of ttriangle;
i, j: byte;
begin
clrscr;
for i := 1 to 2 do
with t[i] do begin
writeln('Enter coords of ', i, ' triangle: ');
writeln;
for j := 1 to 3 do begin
write('top(', j, ').x = '); readln(top[j].x);
write('top(', j, ').y = '); readln(top[j].y);
writeln;
end;
end;
if triangle_in_triangle(t[1], t[2]) then writeln('1 in 2')
else if (triangle_in_triangle(t[2], t[1])) then writeln('2 in 1')
else writeln('none');
readln;
end.
