НАДО НАРИСОВАТЬ МОДЕЛЬ КАРКАСА КУБА... ДЕЛАЛ ПРОГУ ПО НЕМНЮГИНУ... ЕСТЬ ДВЕ ОТДЕЛЬНЫЕ ПРОГИ.. В ОДНОЙ ОПИСАНИЕ МОДУЛЯ 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.

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;

М

Дубликат. Закрыто.