Правила форума
Прочтите прежде чем задавать вопрос!
Задан треугольник (x1,y1,x2,y2,x3,y3) . Вычислить, какие точки с целыми координатами находятся внутри него и вывести в отдельный файл их количество и координаты.
У меня получилось такое:
Код
Program tochki_treugolnika;
uses crt;
var
f : text;
i, j, ymin, ymax, xmin, xmax, x1, y1, x2, y2, x3, y3, x, y, k : integer;
function rasst ( x1, x2, y1, y2 : real) : real;
begin
rasst := sqrt(sqr(x2-x1)+sqr(y2-y1))
end;
function Angle ( c, a, b : real) : real;
var mycos, mysin : real;
begin
mycos := (a*a+b*b-c*c)/(a*b)/2;
mysin := sqrt (1 - sqr (mycos));
Angle := arctan (mysin/mycos)
end;
function gde (x1,y1,x2,y2,x3,y3,x,y:real) : boolean;
var
an1, an2, an3 : real;
begin
an1 := Angle (rasst (x1, x2, y1, y2), rasst (x1, x, y1, y), rasst (x2, x, y2, y));
an2 := Angle (rasst (x2, x3, y2, y3), rasst (x2, x, y2, y), rasst (x3, x, y3, y));
an3 := Angle (rasst (x3, x1, y3, y1), rasst (x3, x, y3, y), rasst (x1, x, y1, y));
gde := (an1 + an2 + an3 > 2*PI - 0.01)
end;
begin
clrscr;
writeln ('Введите x1,y1,x2,y2,x3,y3');
readln (x1,y1,x2,y2,x3,y3);
{Assign (f,'c:\Pascal\samples\sample33.txt');
Rewrite (f);
}
if x3 < x1 then
if x2 < x3 then xmin := x2
else xmin := x3
else if x2 < x1 then xmin := x2 else xmin := x1;
if x3 > x1 then
if x2 > x3 then xmax := x2
else xmax := x3
else if x2 > x1 then xmax := x2 else xmax := x1;
if y3 < y1 then
if y2 < y3 then ymin := y2
else ymin := y3
else if y2 < y1 then ymin := y2 else ymin := y1;
if y3 > y1 then
if y2 > y3 then ymax := y2
else ymax := y3
else if y2 > y1 then ymax := y2 else ymax := y1;
for x := xmin + 1 to xmax - 1 do
for y := ymin + 1 to ymax - 1 do
begin
if gde (x1,y1,x2,y2,x3,y3,x,y) = false
then
begin
writeln ('Точка (',x,';',y,') находится внутри треугольника ');
inc(k);
end;
end;
writeln ('f, ');
writeln ( 'f‚ В треугольнике находится ',k,' точек');
{ close (f);}
repeat until keypressed
end.
У меня возникает глюк в функции Angle при вычислении то-ли косинуса, то-ли синуса. как мне это исправить?
Админ.
