![]() |
|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
![]() |
|
Опции темы | Поиск в этой теме |
![]() |
#1 |
Новичок
Джуниор
Регистрация: 16.06.2009
Сообщений: 1
|
![]()
Здравствуйте Уважаемы Программисты!
Написал программу Ресующую Дерево а именно "Фрактальное Дерево", помогите натянуть Шейдеры, хотелось бы видеть её в 3D Графике... или как нибудь модифицировать программу.... В архиве есть исходник и дополнительные .TPU Файлы... ну а пока: Вот сам Код: Uses _Vesa_,Graph; Procedure derevo(x,y,ygl,dlina:integer); const k=pi/180;{Naclon Dereva} w=5; {Tolshina Stvola} e=4; {Tolshina Lista} q=25; {Razrostanie Dereva} colors:array[1..20] of byte = ( 2,2, 10,4,4,4,4, 6,6,6,6,6,6,6,6,6,6,6,6,6 ); {Cvet Lista,VetKi, stvola} var x1,y1,i,p,a1:integer; begin if dlina<5 then exit; x1:=round(x+dlina*cos(ygl*k)); y1:=round(y+dlina*sin(ygl*k)); if dlina>100 then p:=100 else p:=dlina; i:=colors[p div 5]; if random(2)=0 then begin if i=colors[1] then i:=colors[2] else if i=colors[2] then i:=colors[1]; end; setcolor( i ); if (i=colors[1]) or (i=colors[2]) then for i:=0 to e do Line(x+i-e div 2,y,x1,y1) else for i:=0 to p div w do Line(x+i-p div (w*2),y,x1,y1); for i:=0 to 3-random(3) do begin p:=random(dlina-dlina div 6)+dlina div 6; a1:=ygl-random(55); x1:=round(x+p*cos(ygl*k)); y1:=round(y+p*sin(ygl*k)); if dlina>100 then derevo(x1,y1,a1,100-random(15)-q+random(q)) else derevo(x1,y1,a1,dlina-random(15)-q+random(q)); p:=random(dlina-dlina div 6)+dlina div 6; a1:=ygl+random(55); x1:=round(x+p*cos(ygl*k)); y1:=round(y+p*sin(ygl*k)); if dlina>100 then derevo(x1,y1,a1,100-random(15)-q+random(q)) else derevo(x1,y1,a1,dlina-random(15)-q+random(q)); end; end; begin randomize; SetVesa; SetGraphMode(2); readln; VesaDone; end. |
![]() |
![]() |
![]() |
![]() |
||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Кто-нибудь есть спец по графам, помогите сделать программу .... | Freez | Паскаль, Turbo Pascal, PascalABC.NET | 5 | 10.04.2009 12:27 |
Помогите разобраться... Написал программу | Neset | Работа с сетью в Delphi | 3 | 26.02.2009 11:39 |