КУБИК 3D ГРАФИКА, ПОМОГИТЕ ПОЖАЛУЙСТА... СРОЧНО НАДО... Опции

[batmans86]

НАДО НАРИСОВАТЬ МОДЕЛЬ КАРКАСА КУБА... ДЕЛАЛ ПРОГУ ПО НЕМНЮГИНУ... ЕСТЬ ДВЕ ОТДЕЛЬНЫЕ ПРОГИ.. В ОДНОЙ ОПИСАНИЕ МОДУЛЯ GRAPHS3D, А В ДРУГОЙ ПОСТРОЕНИЕ САМОГО КУБА... ПРОГРАММА ЗАПУСКАЕТСЯ.. НО ОТОБРАЖАЕТСЯ ПАРАЛЕЛЛОГРАМ... ПОМОГИТЕ ПОЖАЛУЙСТА СДЕЛАТЬ ДО КОНЦА ПРОГУ...





Unit graphs3d;
interface
uses Dos, crt, graph;
type
vector = array[1..3] of real;
promt = array[1..4] of vector;
prom = array[1..3] of vector;
var
abs_x_center, abs_y_center : integer;

procedure open_graph;
procedure close_graph;
procedure out_text_XY(ss : string; x,y : integer; color : word);
procedure norm_line(x0, y0, x1, y1 : integer; color : word);
procedure put_pixel(x, y : integer; color : word);
procedure computer_iso (var P: prom);
procedure computer_dim (alpha:Real; var P: prom);
procedure computer_ob_matr (alpha:Real; var P: prom);
procedure thach(const P : prom; const x, y, z : real;
const u0, v0 : integer; var u, v : integer);

implementation

var
hold_color : word;

procedure open_graph;
var
GraphDriver, GraphMode : integer;
begin
GraphDriver := VGA;
GraphMode := VGAHi;
InitGraph(GraphDriver, GraphMode, '..\bgi');
setBkColor(black);
SetColor(white);
SetTextStyle(SansSerifFont, HorizDir, 4);
SetTextJustify(LeftText, BottomText);
abs_x_center := (GetMaxX + 1) div 2;
abs_y_center := (GetMaxY + 1) div 2;
end;

procedure Close_graph;
var
gr: integer;
begin
CloseGraph;
gr := GraphResult;
if gr <> 0 then
begin
writeln('GraphResult = ', gr);
readln;
halt;
end;
end;

procedure out_text_XY(ss : string; x, y : integer; color : Word);
begin
hold_color := getcolor;
setcolor(color);
OutTextXY(x + abs_x_center, abs_y_center - y, ss);
setcolor(hold_color);
end;

procedure norm_line(x0, y0, x1, y1 : integer; color : word);
begin
hold_color := GetColor;
SetColor(color);
line(x0 + abs_x_center, abs_y_center - y0,
x1 + abs_x_center, abs_y_center - y1);
setcolor(hold_color);
end;



procedure put_pixel(x, y: Integer; color: Word);
begin
PutPixel(x+abs_x_center, abs_y_center - y, color);
end;

procedure computer_iso(var P: prom);
begin

P[1, 1]:= -1.0/sqrt(2.0);
P[1, 2]:= - P[1, 1] ;
P[1, 3]:= 0.0;
P[2, 1]:= -1.0/sqrt(6.0);
P[2, 2]:= P[2, 1];
P[2, 3]:= -2.0*P[2,1];
end;

procedure computer_dim(alpha: Real; var P: prom);
var
t: Real;
begin
alpha:=Pi*alpha/180.0;
P[1, 1]:= -1.0/sqrt(2.0);
P[1, 2]:= - P[1, 1] ;
P[1, 3]:= 0.0;
t:= sin(alpha)/cos(alpha);
P[2, 1]:= t*P[1,1];
P[2, 2]:=P[2, 1] ;
P[2, 3]:= sqrt(1.0-sqr(t));
end;

procedure computer_ob_matr(alpha: Real; var P: prom);
begin
alpha:=Pi*alpha/180.0;
P[1, 1]:= -Sin(alpha);
P[1, 2]:= 1.0;
P[1, 3]:= 0.0;
P[2, 1]:= -Cos(alpha);
P[2, 2]:= 0.0;
P[2, 3]:= 1.0;
end;

procedure thach(const p: prom; const x, y, z : real;
const u0, v0 : integer; var u, v : integer);
begin
u := u0 + round(p[1, 1] * x + p[2, 1] * y + p[3, 1] * z);
v := v0 + round(p[1, 2] * x + p[2, 2] * y + p[3, 2] * z);
end;
end.


Добавлено через 3 мин.
А ВОТ ПОСТРОЕНИЕ КУБИКА:



program prog1;

uses
Graph, crt, graphs3d;
var
x, z,y, xstep, ystep, alpha: Real;
i,j,xold, yold, xnew, ynew: Integer;
P: prom;

const
xCount = 50;
yCount = 50;
xMin = -100;
xMax = 100;
yMin = -100;
yMax = 100;

function Fun (x,y:Real) :Real;
begin
Fun:=Cos(Sqrt(x*x+y*y));
end;


procedure init;
begin
ClearViewPort;
Setcolor(14);
SetBkColor(1);
end;

procedure FindScreenCoordinates (var x , y:Real; var xp,yp: Integer);
begin
z:=10*Fun(0.1*x, 0.1*y);
thach(P, x, y, z,0, 0 , xnew, ynew);
end;





procedure draw_cube;
var
xp, yp: array[1..8] of Integer;
begin
thach(P , 50, 50, 50, 0, 0, xp[1], yp[1]);
thach(P , -50, 50, 50, 0, 0, xp[2], yp[2]);
thach(P , -50, -50, 50, 0, 0, xp[3], yp[3]);
thach(P , 50, -50, 50, 0, 0, xp[4], yp[4]);
thach(P , 50, 50, -50, 0, 0, xp[5], yp[5]);
thach(P , -50, 50, -50, 0, 0, xp[6], yp[6]);
thach(P , -50, -50, -50, 0, 0, xp[7], yp[7]);
thach(P , 50, -50, -50, 0, 0, xp[8], yp[8]);

norm_line(xp[2], yp[2], xp[1], yp[1], white);
norm_line(xp[3], yp[3], xp[2], yp[2], white);
norm_line(xp[4], yp[4], xp[3], yp[3], white);
norm_line(xp[1], yp[1], xp[4], yp[4], white);
norm_line(xp[5], yp[5], xp[1], yp[1], white);
norm_line(xp[6], yp[6], xp[5], yp[5], white);
norm_line(xp[7], yp[7], xp[6], yp[6], Lightgray);
norm_line(xp[8], yp[8], xp[7], yp[7], Lightgray);
norm_line(xp[5], yp[5], xp[8], yp[8], white);
norm_line(xp[2], yp[2], xp[6], yp[6], white);
norm_line(xp[7], yp[7], xp[3], yp[3], Lightgray);
norm_line(xp[4], yp[4], xp[8], yp[8], white);
end;

procedure draw_surf;
begin
Xstep:= (xMax - xMin)/ xCount;
Ystep:= (yMax - yMin)/ yCount;
for i:=0 to xcount do
begin
x:=xmin+i*xstep;
y:=ymin;
FindScreenCoordinates (x, y, xnew, ynew);
xold:= xnew;
yold:= ynew;
for j:=0 to ycount do
begin
y:=ymin+j*ystep;

FindScreenCoordinates (x, y, xnew, ynew);
norm_line(xnew, ynew, xold, yold, Yellow);
xold:= xnew;
yold:= ynew;
end;
end;
for i:=0 to ycount do
begin
y:=ymin+i*ystep;
x:=xmin;
FindScreenCoordinates (x, y, xnew, ynew);
xold:= xnew;
yold:= ynew;
for j:=0 to xcount do
begin
x:=xmin+j*xstep;

FindScreenCoordinates (x, y, xnew, ynew);
norm_line(xnew, ynew, xold, yold, Yellow);

xold:= xnew;
yold:= ynew;
end;
end;
end;




begin
abs_x_center:=0; abs_y_center:=0;
open_graph;

computer_iso(p); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_cube;
Readln;

alpha:=15;
computer_ob_matr(alpha, P); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_cube;
Readln;

alpha:=15;
computer_dim(alpha, P); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_cube;
Readln;

computer_iso(p); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_surf;
Readln;

alpha:=45;
computer_ob_matr(alpha, P); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_surf;
Readln;

alpha:=15;
computer_dim(alpha, P); init;
out_text_XY('CUBIK', -150,150, Yellow);
draw_surf;
Readln;



close_graph;

end.

[Michael_Rybak]

М

Не нужно кричать. И пользуйся тегом code

Сообщение отредактировано: Michael_Rybak - 25.03.2008 17:00

[Rian]

А надо нарисовать куб или квадрат?