Форум программистов, компьютерный форум CyberForum.ru Форум программистов | Компьютерный форум | Форум web-программистов | Форум по электронике и бытовой технике | Форум о софте | Научный форум | Карьера и бизнес
CyberForum.ru - форум программистов и сисадминов > Форум Форум программистов > Форум Pascal (Паскаль) > Форум Turbo Pascal
Восстановить пароль Регистрация

Ответ Создать новую тему
 
04.09.2010, 07:02   #1
cl0oud
Форумчанин
Регистрация: 17.11.2009
Сообщений: 56
Репутация: 0 (0)
Создать приложение по разделу аналитической геометрии «Треугольник». Приложение должно содержать:
1) подпрограммы, реализующие:
а) алгоритм нахождения высот (по координатам вершин треугольника);
б) алгоритм нахождения медиан;
с) алгоритм нахождения биссектрис.

2) приложение должно содержать графические компоненты.
04.09.2010, 07:02
AdAgent
Объявления
04.09.2010, 17:45   #2
Puporev
Модератор
Регистрация: 18.05.2008
Сообщений: 64,949
Репутация: 42017 (30537)
Лучшие ответы: 1,723
Вот написал я вам медианы и биссектрисы, здесь координаты определяются на основании их свойств пропорциональности:
- медиана делит сторону пополам
- биссектриса пропорционально прилежащим сторонам.
с высотами легкого решения не знаю, а с уравнениями прямых и решением систем лень заморачиваться, попробуйте сами. Это 1 процедуру дописать.
Код Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
uses crt,graph;
type point=record
           x,y:real;
           end;
var gd,gm,w,h,cl:integer;
    a,b,c,ma,mb,mc,ba,bb,bc:point;
    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;
{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,mx: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
   mx:=(h-60)/(xmax*2);
   n:=round(xmax);
  end
else
  begin
   mx:=(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*mx),w,y0-round(i*mx));
  line(0,y0+round(i*mx),w,y0+round(i*mx));
  line(x0-round(i*mx),0,x0-round(i*mx),h);
  line(x0+round(i*mx),0,x0+round(i*mx),h);
  str(i,s);
  OutTextXY(x0-10,y0-round(i*mx),s);
  OutTextXY(x0-20,y0+round(i*mx),'-'+s);
  OutTextXY(x0+round(i*mx),y0+5,s);
  OutTextXY(x0-round(i*mx)-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*mx);ya:=y0-round(a.y*mx);
xb:=x0+round(b.x*mx);yb:=y0-round(b.y*mx);
xc:=x0+round(c.x*mx);yc:=y0-round(c.y*mx);
xt1:=x0+round(t1.x*mx);yt1:=y0-round(t1.y*mx);
xt2:=x0+round(t2.x*mx);yt2:=y0-round(t2.y*mx);
xt3:=x0+round(t3.x*mx);yt3:=y0-round(t3.y*mx);
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);
Med(a,b,c,ma,mb,mc,dma,dmb,dmc);
writeln('Dlina mediany A=',dma:0:2);
writeln('Dlina mediany B=',dmb:0:2);
writeln('Dlina mediany C=',dmc:0:2);
writeln;
Bis(a,b,c,ba,bb,bc,dba,dbb,dbc);
writeln('Dlina bissektrisy A=',dba:0:2);
writeln('Dlina bissektrisy B=',dbb:0:2);
writeln('Dlina bissektrisy C=',dbc:0:2);
writeln;
write('Press Enter...');
readln;
until(c.x>=-10)and(c.x<=10)and(c.y>=-10)and(c.y<=10);
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;
end.
Добавлено через 1 час 22 минуты
Если вы уже смотрели код до времени последней правки, то замените, я исправил ошибки.

Добавлено через 21 минуту
Добавил высоты.
Код Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
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.
Другие темы раздела
Написать программу вычисления площади треугольникаю. Turbo Pascal
Написать программу вычисления площади треугольника, если известна длина основания и высота.
Turbo Pascal Определить, является ли целое число N четным двузначным числом.
Определить, является ли целое число N четным двузначным числом.
04.09.2010, 17:45
Yandex
Объявления
После регистрации реклама в сообщениях будет скрыта и будут доступны все возможности форума.
Ответ Создать новую тему

Похожие темы
Тема Раздел Автор Дата
Pascal составить программу нахождения периметра треугольника по заданным координатам его вершин,используя подпрограмму нахождения растояния между двумя точк.
составить программу для нахождения периметра треугольника по заданным координатам его вершин,используя подпрограмму нахождения растояния между двумя точками))чере процедуры))
Pascal (Паскаль) лариса 1 13.02.2013 22:30
C++ Найдите точки пересечения высот и медиан треугольника
Найдите точки пересечения высот и медиан треугольника, вершины которого расположены в точках (x1, y1), (x2, y2) и (x3, y3).
С++ для начинающих asdfghjj 11.02.2013 13:07
Написать уравнения сторон, медиан, высот треугольника - Геометрия
Привет ребята помогите пожалуйста даны координаты треугольника abc A(-9,4) B(10,3) C(-3,1) 1.Записать уравнения сторон (в общем виде).Найти длины сторон 2,Найти уравнение прямых, проходящих через вершины треугольника ABC а)параллельно оси ОХ б) перпендикулярно оси ОХ с)образующих с осью...
Геометрия arsemid 20.10.2012 15:03
Turbo Pascal по координатам вершин треугольника определить координаты точек пересечения высот, биссектрис и медиан
Составить программу,которая по заданным координатам вершин треугольника(Xi,Yi,i=1,2,3) определяла бы координаты точек пересечения высот XH,YH, биссектрис XB,YB и медиан XM,YM.
Turbo Pascal Ivansm 09.10.2011 22:28
Delphi Построить закрашенный треугольник по координатам его вершин и отметить точки пересечения высот,медиан и биссектрис
Задачка попалась........:( нефига не могу разобраться....:( Помогите...... Построить закрашенный треугольник по координатам его вершин и отметить точки пересечения высот,медиан и биссектрис.Напечатать соответствующие координаты.
Delphi: графика, звук, видео sdn 18.03.2009 11:07
Опции темы

Текущее время: 12:39. Часовой пояс GMT +4.

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.7 PL3
Copyright ©2000 - 2014, vBulletin Solutions, Inc.