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

> Внимание!

Давайте пожалуйста своим демо названия!
В названии темы указывайте название!

 
 Ответить  Открыть новую тему 
> Кубик(и не только) на паскале, Помогите сделать поворот сверху вних и наоборот
Александр-3000
сообщение 20.02.2008 16:58
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской

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


Вот исходник и сама программа.
На шрифт внимания не обращайте так как в Паскале будет видно все нормально.
Запускать CUB.BAT это вместо русского языка будет одна фигня.
Помогите реализовать поворот сверху вниз и снизу вверх. Заранее благодарен.


Сам код:
program CUB;
uses CRT,GRAPH;
var GD,GM,I,Iq:integer;
D,K,AL,AK,A,B,XQ,YQ,ZQ,R,RQ,R1,X0,Y0:real;
KT,ALT,RT:string;
CH:char;
X,Y,X1,Y1:array [1..9] of integer;
const S=0.707106781;
procedure TOHKA;
begin
R1:=D*R;
a:=(al*pi)/180;
a:=a-(0.25*pi);
xq:=r*cos(a-(0.5*pi)); yq:=0.5*r*sin(a-(0.5*pi)); zq:=0-(0.5*r);
x[1]:=round((x0+xq-yq*s)); y[1]:=round((y0+yq*s-zq));
xq:=r*cos(a); yq:=0.5*r*sin(a); zq:=0-(0.5*r);
x[2]:=round((x0+xq-yq*s)); y[2]:=round((y0+yq*s-zq));
xq:=r1*cos(a); yq:=0.5*r1*sin(a); zq:=r-(0.5*r);
x[3]:=round((x0+xq-yq*s)); y[3]:=round((y0+yq*s-zq));
xq:=r1*cos(a-(0.5*pi)); yq:=0.5*r1*sin(a-(0.5*pi)); zq:=r-(0.5*r);
x[4]:=round((x0+xq-yq*s)); y[4]:=round((y0+yq*s-zq));
xq:=r*cos(a-pi); yq:=0.5*r*sin(a-pi); zq:=0-(0.5*r);
x[5]:=round((x0+xq-yq*s)); y[5]:=round((y0+yq*s-zq));
xq:=r*cos(a+(0.5*pi)); yq:=0.5*r*sin(a+(0.5*pi)); zq:=0-(0.5*r);
x[6]:=round((x0+xq-yq*s)); y[6]:=round((y0+yq*s-zq));
xq:=r1*cos(a+(0.5*pi)); yq:=0.5*r1*sin(a+(0.5*pi)); zq:=r-(0.5*r);
x[7]:=round((x0+xq-yq*s)); y[7]:=round((y0+yq*s-zq));
xq:=r1*cos(a-pi); yq:=0.5*r1*sin(a-pi); zq:=r-(0.5*r);
x[8]:=round((x0+xq-yq*s)); y[8]:=round((y0+yq*s-zq));
end;
Procedure CUB;
begin
for i:=1 to 8 do
for iq:=1 to 8 do
line(x[i],y[i],x[iq],y[iq]);
Str(AL:3:1,ALT); RQ:=R/100; Str(RQ:1:2,RT); Str(K:1:2,KT);
OutTextXY(160,20,ALT); OutTextXY(100,30,RT); OutTextXY(80,40,KT);
end;
procedure USLOVIE;
begin
ch:=readkey;
setcolor(0);
cub;
setcolor(15);
case ch of
#53: k:=k+0.2;
#48: k:=abs(k-0.2);
#43: r:=r+k;
#45: r:=r-k;
#75: begin al:=al+k; if al>=360 then al:=0; end;
#77: begin al:=al-k; if al<=-360 then al:=0; end;
#52: x0:=x0-k;
#54: x0:=x0+k;
#56: y0:=y0-k;
#50: y0:=y0+k;
#51: begin y0:=y0+k; x0:=x0+k; end;
#55: begin y0:=y0-k; x0:=x0-k; end;
#49: begin y0:=y0+k; x0:=x0-k; end;
#57: begin y0:=y0-k; x0:=x0+k; end;
#42: D:=D+0.05;
#47: D:=D-0.05;
end;
end;
Procedure TEXT;
begin
OutTextXY(10,GetmaxY-10,'„«п ўл室 ­ ¦¬ЁвҐ ESC.');
OutTextXY(10,GetmaxY-20,'‘Є®а®бвм: "+" - 5 Ё "-" - 0.');
OutTextXY(10,GetmaxY-30,'”ўҐ«ЁзҐ­ЁҐ "+" Ё "-".');
OutTextXY(10,GetmaxY-40,'Ќ ўЁЈ жЁп:1 2 3 4 6 7 8 9.');
OutTextXY(10,GetmaxY-50,'Џ®ў®а®в дЁЈгал бв५®зЄ ¬Ё.');
OutTextXY(10,10,'€§¬Ґ­Ґ­ЁҐ ўҐае­ҐЈ® ®б­®ў ­Ёп "/" Ё "*".');
OutTextXY(160,20,ALT);OutTextXY(10,20,'Џ®ў®а®в ў Ја ¤гб е');
OutTextXY(10,30,'”ўҐ«ЁзҐ­ЁҐ');
OutTextXY(10,40,'‘Є®а®бвм');
end;
BEGIN
gd:=ega; gm:=1; initgraph(gd,gm,'');
r:=150;
D:=1;
al:=0;
x0:=320;
y0:=175;
K:=2.5;
REPEAT
USLOVIE;
TOHKA;
CUB;
TEXT;
UNTIL ch=#27;
END.


Сообщение отредактировано: volvo - 30.03.2010 19:04


Прикрепленные файлы
Прикрепленный файл  CUB.rar ( 31.89 килобайт ) Кол-во скачиваний: 588
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



- Текстовая версия 28.03.2024 12:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"