IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Не рисует Pascal 7. В чем Проблема?, Написал программу, а Pascal не чертит.
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Алксандр

Репутация: -  0  +


Написал порграмму для внешнего сопряжения двух окружностей, а она не выдает чертеж. может кто поможет

program circleAlexGxx;
uses crt, graph;
Label 1;
var i,stad:integer;
gd,gm:integer;
x,y,r1,r2,dx,dy:integer;
c:char;
S,B,K,H,xx,yy,x1,x2,y1,y2,rs:real;
xc,yc,xc1,xc2,yc1,yc2,l1,l,ang:real;
a:real;
BEGIN
x:=320;
y:=240;
dx:=0;
dy:=0;
r1:=0;
r2:=0;
rs:=0;

stad:=1;
i:=1;
1:
clrscr;
if (stad=1) then
begin
textcolor(white);
gotoxy (1,1);
Writeln ('BBEDUTE DAHHbIE');


if (i=1) then
textcolor(green) else textcolor(white);
gotoxy (1,4);
Writeln ('R1(radius 1 okr.)= ',r1,' Max 140');
if (i=2) then
textcolor(green) else textcolor(white);
gotoxy (1,5);
Writeln ('R2(radius 2 okr.)= ',r2,' Max 140');
if (i=3) then
textcolor(green) else textcolor(white);
gotoxy (1,6);
Writeln ('dX(rasstojanie mezhdu okr po osi X)= ',dx,' Max ',2*x-R1*2-R2*2);
if (i=4) then
textcolor(green) else textcolor(white);
gotoxy (1,7);
Writeln ('dY(rasstojanie mezhdu okr po osi Y)= ',dy,' Max ',2*y-R1*2-R2*2);
if (i=5) then
textcolor(green) else textcolor(white);
gotoxy (1,8);
Writeln ('RS(radius sopriazhenia)= ',round(rs),' Min 100');
if (i=6) then
textcolor(green) else textcolor (white);
gotoxy (1,9);
Writeln ('Paint');
gotoxy (1,20);
if (i=7) then
textcolor(green) else textcolor(white);
gotoxy (1,11);
Writeln ('EXIT');

gotoxy (4,15);
textcolor (10);
writeln ('Vipolnil');
gotoxy (4,16);
writeln ('student 2 kursa');
gotoxy (4,17);
writeln ('grup 3121b');
gotoxy (4,18);
writeln ('Gridnev Alexandr');
gotoxy (2,21);
writeln ('Voronezh 2011');


c:=readkey;
if (ord©=72) then i:=i-1;
if (ord©=80) then i:=i+1;
if (ord©=13) then stad:=2;
if (ord©=27) then stad:=3;
if (i=8) then i:=1;
if (i=0) then i:=7;
goto 1;
end;
if (stad=2) then
begin
clrscr;
case i of
1: begin gotoxy (30,6); textcolor (white); Write('[',Round(r1),'] R1= '); readln (r1); stad:=1; goto 1; end;
2: begin gotoxy (30,6); textcolor (white); Write('[',Round(r2),'] R2= '); readln (r2); stad:=1; goto 1; end;
3: begin gotoxy (30,6); textcolor (white); Write('[',round(dx),'] dX= '); readln (dx); stad:=1; goto 1; end;
4: begin gotoxy (30,6); textcolor (white); Write('[',round(dy),'] dy= '); readln (dy); stad:=1; goto 1; end;
5: begin gotoxy (30,6); textcolor (white); Write('[',round(rs),'] RS= '); readln (Rs); stad:=1; goto 1; end;
6: begin gotoxy (30,6); stad:=3; goto 1; end;
7: begin gotoxy (30,6); stad:=4; goto 1; end;
end;
end;
if (stad=4) then
begin

Detectgraph (gd,gm);

Initgraph (gd,gm,'');
setcolor(green);
Line (2,2,638,2);
Line (2,2,2,478);
Line (638,2,626,8);
Line (638,2,626,-6);
Line (2,478,6,470);
Line (2,478,-5,470);
outtextXY(4,4,'O');
outtextXY (630,7,'X');
outtextXY (4,470,'Y');
setcolor (red);
circle (x-round(dx/2),y+round(dy/2),r1);
circle (x+round(dx/2),y-round(dy/2),r2);
circle (x-round(dx/2),y+round(dy/2),2);
circle (x+round(dx/2),y-round(dy/2),2);
readln;
setcolor(white);


x1:=x-round(dx/2); writeln ('x1=',x1:3:0);
y1:=y+round(dy/2); writeln ('y1=',y1:3:0);
x2:=x+round(dx/2); writeln ('x2=',x2:3:0);
y2:=y-round(dy/2); writeln ('y2=',y2:3:0);
{===============================}
S:=sqrt(sqr(x2-x1)+sqr(y2-y1));
writeln ('S=',s:4:2);

B:=(sqr(rs-r2)-sqr(rs-r1)+sqr(s))/(2*s); write ('B= ',B:3:2);
k:=s-b;
H:=sqrt(sqr(rs-r2)-sqr(b));
xx:=round(x1+(x2-x1)/(s/k));
yy:=round(y1+(y2-y1)/(s/k));

xc:=round(xx-(yy-y2)*H/B);
yc:=round(yy+(xx-x2)*H/B);
xc:=round(xx+(yy-y2)*H/B);
yc:=round(yy-(xx-x2)*H/B);


a:=sqrt(sqr((xc+rs)-x2)+sqr(yc-y2));

setcolor(green);
circle (round(xc),round(yc),2);
ang:=0;
xc1:=0;
yc1:=0;
xc2:=0;
yc2:=0;
while ang<(pi*2) do begin
PutPIxel (round(x1+r1*cos(ang)),round(y1+r1*sin(ang)),white);
PutPIxel (round(x2+r2*cos(ang)),round(y2+r2*sin(ang)),white);
if (round(xc+rs*cos(ang))=round(x1+r1*cos(ang))) then xc1:=round(xc+rs*cos(ang));
if (round(yc+rs*sin(ang))=round(y1+r1*sin(ang))) then yc1:=round(yc+rs*sin(ang));
if (round(xc+rs*cos(ang))=round(x2+r2*cos(ang))) then xc2:=round(xc+rs*cos(ang));
if (round(yc+rs*sin(ang))=round(y2+r2*sin(ang))) then yc2:=round(yc+rs*sin(ang));
ang:=ang+0.005;
end;
ang:=0;
while ang<(pi*2) do begin
if (round(yc+rs*sin(ang))<yc1) and (round(xc+rs*cos(ang))<xc2) then
PutPixel (round(xc+rs*cos(ang)),round(yc+rs*sin(ang)),white);
ang:=ang+0.003;
end;
readln;
stad:=1;
restoreCrtmode;
goto 1;
end;
readln;
if (stad=3) then
end.



Вот тут и файлик есть.

Сообщение отредактировано: AlexGxx -


Прикрепленные файлы
Прикрепленный файл  ALEXGXX.pas ( 4.28 килобайт ) Кол-во скачиваний: 627
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 18.05.2024 16:42
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name