Создать приложение по разделу аналитической геометрии «Треугольник». Приложение должно содержать:1) подпрограммы, реализующие: а) алгоритм нахождения высот (по координатам вершин треугольника); б) алгоритм нахождения медиан;с) алгоритм нахождения биссектрис — Pascal(Паскаль)

uses crt,graph;
const t=0.0001;
type point=record
           x,y:real;
           end;
var gd,gm,w,h,cl:integer;
    a,b,c,ma,mb,mc,ba,bb,bc,va,vb,vc:point;
    dma,dmb,dmc:real;
    dba,dbb,dbc:real;
    dva,dvb,dvc:real;
{opredelenie dliny po Geronu}
function Dlina(a,b:point):real;
begin
Dlina:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));
end;
{koordinaty osnovanij i dliny median}
procedure Med(a,b,c:point;var ma,mb,mc:point;var dma,dmb,dmc:real);
begin
ma.x:=(b.x+c.x)/2;ma.y:=(b.y+c.y)/2;
mb.x:=(a.x+c.x)/2;mb.y:=(a.y+c.y)/2;
mc.x:=(a.x+b.x)/2;mc.y:=(a.y+b.y)/2;
dma:=Dlina(a,ma);
dmb:=Dlina(b,mb);
dmc:=Dlina(c,mc);
end;
{koordinaty osnovanij i dliny bissektris}
procedure Bis(a,b,c:point;var ba,bb,bc:point;var dba,dbb,dbc:real);
var l1,l2,l3:real;
begin
l1:=Dlina(a,b);
l2:=Dlina(b,c);
l3:=Dlina(c,a);
ba.x:=b.x+l1*(c.x-b.x)/(l1+l3);
ba.y:=b.y+l1*(c.y-b.y)/(l1+l3);
bb.x:=c.x+l2*(a.x-c.x)/(l1+l2);
bb.y:=c.y+l2*(a.y-c.y)/(l1+l2);
bc.x:=a.x+l3*(b.x-a.x)/(l2+l3);
bc.y:=a.y+l3*(b.y-a.y)/(l2+l3);
dba:=Dlina(a,ba);
dbb:=Dlina(b,bc);
dbc:=Dlina(c,bc);
end;
{koordinaty osnovanij i dliny vysot}
procedure Vys(a,b,c:point;var va,vb,vc:point;var dva,dvb,dvc:real);
var p,l1,l2,l3,u,h,c1,k:real;
begin
l1:=Dlina(a,b);
l2:=Dlina(b,c);
l3:=Dlina(c,a);
p:=(l1+l2+l3)/2;
u:=2*arctan(sqrt((p-l1)*(p-l3)/(p*(p-l2))));
dvb:=l1*sin(u);
c1:=sqrt(l1*l1-dvb*dvb);
if abs(c.x-a.x)<=t then
 begin
  vb.x:=a.x;
  vb.y:=a.y;
 end
else
 begin
  k:=c1/l3;
  vb.x:=a.x+k*(c.x-a.x);
  vb.y:=a.y+k*(c.y-a.y);
 end;
u:=2*arctan(sqrt((p-l2)*(p-l1)/(p*(p-l3))));
dvc:=l2*sin(u);
c1:=sqrt(l2*l2-dvc*dvc);
if abs(a.x-b.x)<=t then
 begin
  vc.x:=b.x;
  vc.y:=b.y;
 end
else
 begin
  k:=c1/l1;
  vc.x:=b.x+k*(a.x-b.x);
  vc.y:=b.y+k*(a.y-b.y);
 end;
u:=2*arctan(sqrt((p-l3)*(p-l2)/(p*(p-l1))));
dva:=l3*sin(u);
c1:=sqrt(l3*l3-dva*dva);
if abs(b.x-c.x)<=t then
 begin
  va.x:=c.x;
  va.y:=c.y;
 end
else
 begin
  k:=c1/l3;
  va.x:=c.x+k*(b.x-c.x);
  va.y:=c.y+k*(b.y-c.y);
 end;
end;
{risovanie}
procedure Draw(w,h:integer;a,b,c,t1,t2,t3:point;cl:integer);
var x0,y0,xa,ya,xb,yb,xc,yc,xt1,yt1,xt2,yt2,xt3,yt3,n,i:integer;
    xmax,ymax,msh:real;
    s:string;
begin
x0:=w div 2;y0:=h div 2;{centr}
xmax:=abs(a.x);{maximum po X}
if abs(b.x)>xmax then xmax:=abs(b.x);
if abs(c.x)>xmax then xmax:=abs(c.x);
ymax:=abs(a.y);{maximum po Y}
if abs(b.y)>ymax then ymax:=abs(b.y);
if abs(c.y)>ymax then ymax:=abs(c.y);
{masshtaby po osyam}
if xmax>ymax then
  begin
   msh:=(h-60)/(xmax*2);
   n:=round(xmax);
  end
else
  begin
   msh:=(h-60)/(ymax*2);
   n:=round(ymax);
  end;
{koordinatnaya setka}
line(0,y0,w,y0);
line(x0,0,x0,h);
setlinestyle(1,0,0);
setcolor(8);
for i:=1 to 2*n do
 begin
  line(0,y0-round(i*msh),w,y0-round(i*msh));
  line(0,y0+round(i*msh),w,y0+round(i*msh));
  line(x0-round(i*msh),0,x0-round(i*msh),h);
  line(x0+round(i*msh),0,x0+round(i*msh),h);
  str(i,s);
  OutTextXY(x0-10,y0-round(i*msh),s);
  OutTextXY(x0-20,y0+round(i*msh),'-'+s);
  OutTextXY(x0+round(i*msh),y0+5,s);
  OutTextXY(x0-round(i*msh)-10,y0+5,'-'+s);
 end;
setcolor(Yellow);
OutTextXY(x0-10,y0+5,'0');
OutTextXY(x0-10,5,'Y');
OutTextXY(GetMaxX-12,y0-10,'X');
{treugolnik}
xa:=x0+round(a.x*msh);ya:=y0-round(a.y*msh);
xb:=x0+round(b.x*msh);yb:=y0-round(b.y*msh);
xc:=x0+round(c.x*msh);yc:=y0-round(c.y*msh);
xt1:=x0+round(t1.x*msh);yt1:=y0-round(t1.y*msh);
xt2:=x0+round(t2.x*msh);yt2:=y0-round(t2.y*msh);
xt3:=x0+round(t3.x*msh);yt3:=y0-round(t3.y*msh);
setlinestyle(0,0,1);
setcolor(2);
line(xa,ya,xb,yb);
line(xa,ya,xc,yc);
line(xb,yb,xc,yc);
setcolor(cl);
line(xa,ya,xt1,yt1);
line(xb,yb,xt2,yt2);
line(xc,yc,xt3,yt3);
end;
begin
clrscr;
writeln('Koordinaty po chasovoj strelke [-10..10]:');
repeat
writeln('Vershina A:');
readln(a.x,a.y);
until(a.x>=-10)and(a.x<=10)and(a.y>=-10)and(a.y<=10);
repeat
writeln('Vershina B:');
readln(b.x,b.y);
until(b.x>=-10)and(b.x<=10)and(b.y>=-10)and(b.y<=10);
repeat
writeln('Vershina C:');
readln(c.x,c.y);
until(c.x>=-10)and(c.x<=10)and(c.y>=-10)and(c.y<=10);
Med(a,b,c,ma,mb,mc,dma,dmb,dmc);
writeln('Dlina mediany A=',dma:0:1);
writeln('Dlina mediany B=',dmb:0:1);
writeln('Dlina mediany C=',dmc:0:1);
writeln('Koordinaty A x=',ma.x:0:1,'  y=',ma.y:0:1);
writeln('Koordinaty B x=',mb.x:0:1,'  y=',mb.y:0:1);
writeln('Koordinaty C x=',mc.x:0:1,'  y=',mc.y:0:1);
writeln;
Bis(a,b,c,ba,bb,bc,dba,dbb,dbc);
writeln('Dlina bissektrisy A=',dba:0:1);
writeln('Dlina bissektrisy B=',dbb:0:1);
writeln('Dlina bissektrisy C=',dbc:0:1);
writeln('Koordinaty A x=',ba.x:0:1,'  y=',ba.y:0:1);
writeln('Koordinaty B x=',bb.x:0:1,'  y=',bb.y:0:1);
writeln('Koordinaty C x=',bc.x:0:1,'  y=',bc.y:0:1);
writeln;
Vys(a,b,c,va,vb,vc,dva,dvb,dvc);
writeln('Dlina vysoty A=',dva:0:1);
writeln('Dlina vysoty B=',dvb:0:1);
writeln('Dlina vysoty C=',dvc:0:1);
writeln('Koordinaty A x=',va.x:0:1,'  y=',va.y:0:1);
writeln('Koordinaty B x=',vb.x:0:1,'  y=',vb.y:0:1);
writeln('Koordinaty C x=',vc.x:0:1,'  y=',vc.y:0:1);
write('Press Enter...');
readln;
 
gd:=0;
initgraph(gd,gm,'');
Draw(getmaxX,getmaxY,a,b,c,ma,mb,mc,12);
setcolor(12);
outtextXY(20,40,'MEDIANY');
setcolor(15);
outtextXY(getmaxX div 2-30,getmaxY-40,'Press Enter...');
readln;
cleardevice;
Draw(getmaxX,getmaxY,a,b,c,ba,bb,bc,14);
setcolor(14);
outtextXY(20,40,'BISSEKTRISY');
setcolor(15);
outtextXY(getmaxX div 2-30,getmaxY-40,'Press Enter...');
readln;
cleardevice;
Draw(getmaxX,getmaxY,a,b,c,va,vb,vc,13);
setcolor(13);
outtextXY(20,40,'VYSOTY');
setcolor(15);
outtextXY(getmaxX div 2-30,getmaxY-40,'Press Enter...');
readln
end.

Leave a Comment

− 2 = 1