Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.07.2009, 21:53   #1
kast333
Новичок
Джуниор
 
Регистрация: 10.07.2009
Сообщений: 1
По умолчанию Вращения закрашиваемого октаэдра

Задача:написать программу для изображения многогранника, вращающегося вокруг оси оу. ось вращения не должна совпадать с собственной вертикальной осью фигуры.
октаэдр
проекция:перспектива (1 точки схода)
при выполнении этого задания необходимо реализовывать алгоритм удаления невидимых линий. все грани рисовать закрашеными различными цветами.

Октаэдр вращается полкруга нормально,а затем нижняя его часть пропадает,верхняя же вращается как не бывало...кто имеет опыт программирования в этой области,посмотрите,пожалуйста код:

program octahedron;
uses crt,graph;
type point_position = array [1..3] of real;
type side_position = array [1..3] of point_position;
type oct_coord = array [1..8] of side_position;
const Color: array[1..8] of Integer = (1,2,3,4,5,6,9,10);
{фигура Октаэдр}
const oct: oct_coord= (((100,100,60),(50,100,-40),(100,50,-40)),
((100,100,60),(50,100,-40),(100,150,-40)),
((100,100,-140),(100,50,-40),(50,100,-40)),
((100,100,-140),(100,150,-40),(50,100,-40)),
((100,100,-140),(150,100,-40),(100,50,-40)),
((100,100,-140),(100,150,-40),(150,100,-40)),
((100,100,60),(100,50,-40),(150,100,-40)),
((100,100,60),(150,100,-40),(100,150,-40)));
const p=-0.002;
var
pcos,psin:real;
oct_new,oct_oldct_coord;
dv,mv,x0, y0: integer;

procedure init;
var i,j,k:integer;

begin
x0 := getMaxX div 2;
y0 := getMaxY div 2;
for i:=1 to High(oct) do
for j:=1 to High(oct[i]) do
for k:=1 to High(oct[i,j]) do
begin
oct_new[i,j,k] := oct[i,j,k];
oct_old[i,j,k] := oct[i,j,k];
end;

end;
{алгоритм робертса}
function robert(side:side_position):boolean;
var
a,b,c:real;
i,j:integer;
begin
c:=0;
robert:=true;
for i:=1 to high(side) do
begin
if i=high(side) then j:=1
else j:=i+1;

c:=c+(side[i,1]-side[j,1])*(side[i,2]+side[j,2]);
end;
if c<=0 then robert:=false;

end;
{процедура получения перспективы в одной точке схода}
procedure modif(x,y,z:real;var x1,y1,z1:real);
begin
x1:=x/(p*y+1);
y1:=y/(p*y+1);
z1:=z/(p*y+1);
end;
{прорисовка/стирание октаэдра в зависимости от флага new}
procedure draw_oct(new: boolean;figurect_coord);
var
i,j,k:integer;
area: array [1..3] of PointType;
new_side:side_position;
begin
setcolor(0);
for i:=1 to high(oct_new) do
begin

for k:=1 to high(new_side) do
begin
modif(figure[i,k,1], figure[i,k,2], figure[i,k,3],
new_side[k,1],new_side[k,2],new_side[k,3]);

end;
if robert(new_side) then
begin
if new then
begin
setFillStyle(solidfill, Color[i]);

end
else begin
setFillStyle(solidfill, 0);
end;
for j:=1 to High(new_side) do
begin
area[j].X :=x0+ round(new_side[j,1]);
area[j].Y := round(new_side[j,2]);
end;
fillpoly(sizeOf(area) div sizeOf(pointtype),area);

end;
end;
end;
{поворот октаэдра}
procedure rotate;
var
i, j: integer;
x_new, z_new: real;
begin
for i:=1 to High(oct_new) do
for j:=1 to High(oct_new[1]) do
begin
oct_old[i,j,1] := oct_new[i,j,1];
oct_old[i,j,3] := oct_new[i,j,3];
x_new:=oct_new[i,j,1]*pcos-oct_new[i,j,3]*psin;
z_new:=oct_new[i,j,1]*psin+oct_new[i,j,3]*pcos;
oct_new[i,j,1]:=x_new;
oct_new[i,j,3]:=z_new;
end;
end;
{основная часть программы}
begin
pcos:=cos(0.05);
psin:=sin(0.05);
dv := detect;
initGraph(dv,mv,'');
init;
repeat
rotate;
draw_oct(false,oct_old);
draw_oct(true,oct_new);
delay(10000);
until keypressed;
closegraph;
end.
kast333 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц