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

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

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

> 3d, 3d пирамида-тень
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 12
Пол: Женский
Реальное имя: Таня

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


Помогите пожалуйста , пирамиду нарисовала smile.gif она вертится smile.gif ,но должна отбрасывать тень unsure.gif wacko.gif и с тенью проблемы

Program laba1;
uses
Graph,Crt;

type
pyram=array[1..5] of record x,y,z,v:real end;

{verts-Є®®а¤Ё­ вл (xyz) ўҐаиЁ­ дЁЈгал}
const
verts:pyram=(
(x: 0 ; y: 0; z: 40; v:1), {1-п ўҐаиЁ­ }
(x: 40; y: 0; z: 0; v:1), {2}
(x: 0 ; y: 0; z: -40; v:1), {3}
(x:-40; y: 0; z: 0; v:1), {4}
(x: 0; y: - 90; z: 0; v:1) );{5}
var
c: char;
Gd, Gm,i,yt : Integer; {ѓа дЁЄ }

procedure DrawPyrS(c,xt,yt:Integer);
var
i,midX,midY:Integer;
c1: byte;
ver:array[1..5] of PointType;
begin
midX:= GetMaxX div 2;
midY:= GetMaxY div 2;
for i:=1 to 5 do
begin
ver[i].x:=round(verts[i].x)+Xt+midX;
ver[i].y:=round(verts[i].y)+Yt+midY;
end;
SetColor( c );
Line(ver[1].x, ver[1].y , ver[2].x, ver[2].y);
Line(ver[1].x, ver[1].y , ver[4].x, ver[4].y);
Line(ver[1].x, ver[1].y , ver[5].x, ver[5].y);
Line(ver[2].x, ver[2].y , ver[3].x, ver[3].y);
Line(ver[2].x, ver[2].y , ver[5].x, ver[5].y);
Line(ver[3].x, ver[3].y , ver[4].x, ver[4].y);
Line(ver[3].x, ver[3].y , ver[5].x, ver[5].y);
Line(ver[4].x, ver[4].y , ver[ 5].x, ver[5].y);

end;


Procedure rotTxYz(a: Real; S: Real);{ўа 饭ЁҐ ў®ЄагЈ XYZ + Zoom}
Var
ca,sa,y1,x1,z1: Real;
i: Integer;
begin
for i:=1 to 5 do
begin
ca:=cos(a);
sa:=sin(a);
x1:= verts[i].x*ca*ca + verts[i].y*sa*ca + verts[i].z*sa;
y1:= verts[i].x*((-sa)*ca-ca*sa*sa) + verts[i].y*(ca*ca-sa*sa*sa) + verts[i].z*ca*sa;
z1:= verts[i].x*(sa*sa-ca*sa*ca) + verts[i].y*((-ca)*sa-sa*sa*ca) + verts[i].z*ca*ca;
verts[i].x:=x1*S;
verts[i].y:=y1*S;
verts[i].z:=z1*S;
end
end;

begin
{€­ЁжЁ «Ё§ жЁп Ја дЁЄЁ}
Gd:= Detect;
InitGraph(Gd, Gm, 'D:\progra~1\tp\BGI'); { Џгвм Є BGI ¤а ©ўҐа ¬ }
if GraphResult <> grOk then
Halt;
{ђЁб®ў ­ЁҐ}
yt:=-170;
repeat
for i:=1 to 50
do begin
drawpyrS(2,0,yt);
Delay(10000);
drawpyrS(0,0,yt);
rotTxYz(0.05,1.015);
yt:=yt+6
end;
for i:=1 to 50
do begin
drawpyrS(2,0,yt);
Delay(10000);
drawpyrS(0,0,yt);
rotTxYz(0.05,0.985);
yt:=yt-6
end


until Keypressed;
CloseGraph;
end.


выход esc когда пирамида находится в верхней точке

stefi78, с тегами лучше смотрится, правда? wink.gif

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
stefi78   3d   24.04.2006 21:53
volvo   stefi78, если спроецировать каждую вершину пирамид…   24.04.2006 22:08
Бравый генерал   Если прямоугольно проецировать вершины на горизонт…   24.04.2006 22:33
volvo   Бравый генерал, я где-то написал слово "прямо…   24.04.2006 22:49
Бравый генерал   Вообще-то я и не спорил с тобой (и ни с кем-либо е…   24.04.2006 23:17
stefi78   ИСТОЧНИК СВЕТА ПЕРЕД ПИРАМИДОЙ Т.Е. ГЛАЗА (ЧЕЛОВЕ…   24.04.2006 23:49
lapp   ИСТОЧНИК СВЕТА ПЕРЕД ПИРАМИДОЙ Т.Е. ГЛАЗА (ЧЕЛОВ…   25.04.2006 8:16
Бравый генерал   Ага, т.е. тень вроде как на стену падает, да? Если…   25.04.2006 0:24
stefi78   если сделаешь буду благодарна в паскале я еще тот …   25.04.2006 4:00
Бравый генерал   Ну, имелось наверно ввиду, что источник света - …   26.04.2006 0:09
lapp   Ну, имелось наверно ввиду, что источник света - э…   26.04.2006 7:56
Бравый генерал   Аааа.... Я понял, что ты имеешь ввиду. Да, ты расс…   26.04.2006 19:11
Бравый генерал   Сделал наконец. Прикрепляю архив. В архиве в папке…   26.04.2006 22:47
Jorik   А можно узнать, где взять VESA.TPU? А то пишет Err…   27.04.2006 17:16
Гость   Прикольные картинки получаются! Только вот поп…   28.04.2006 12:44
Бравый генерал   А, точно! Просто у меня там в корне и Vesa.tpu…   27.04.2006 18:40
stefi78   СПАСИБО ОГРОМНОЕ!!! за помощь :give_r…   7.05.2006 19:24


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

 





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