Помощь - Поиск - Пользователи - Календарь
Полная версия: Призма, в основании треугольник
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Анна
Есть программа, которая осуществляет вращение пирамиды с треугольным основанием, как из неё сделать сабж?

uses crt,graph;

type
coords = record
x,y,z:byte;
end;
type
save = record
q,w,e,r: coords;
t:byte;
end;

var a,b,c,d:coords;
    alpha,r,dx1,dy1,dx2,dy2,x,y,z,mx,my,mz,gm,gd:integer;
    alp: real          ;
    ca:char;
    s:string;
    f:file of save;
    f1: save;
BEGIN
repeat
  clrscr;
  gm:=detect;
  writeln('Press "1" to enter new coords');
  Writeln('Press "2" to read coords from file');
  Writeln('Press "3" to EXIT');
  readln(r);
  if r=1 then
  begin
    clrscr;
    writeln('Enter A(x,y,z)');
    readln(a.x,a.y,a.z);
    writeln('Enter B(x,y,z)');
    readln(b.x,b.y,b.z);
    writeln('Enter C(x,y,z)');
    readln(c.x,c.y,c.z);
    writeln('Enter D(x,y,z)');
    readln(d.x,d.y,d.z);
    writeln('Enter Alpha');
    readln(alpha);
  end;
  if r=2 then
  begin
    clrscr;
    writeln('Enter name of file');
    readln(s);
    assign(f,s);
    reset(f);
    read(f,f1);
    a:=f1.q; b:=f1.w; c:=f1.e; d:=f1.r; alpha:=f1.t;
  end;
  if r=3 then break;
 { alpha:=45;

  a.x:=0;
  a.y:=0;
  a.z:=0;

  b.x:=140;
  b.y:=0;
  b.z:=0;

  c.x:=0;
  c.y:=0;
  c.z:=140;

  d.x:=0;
  d.y:=200;
  d.z:=0; }
  initgraph(gm,gd,'');
  repeat
  alp:=pi/180*alpha;
  setcolor(white);
  str(alpha,s);
  outtextxy(0,0,s);
  setcolor(yellow);
  dy2:=round(cos(alp)*300);
  dx2:=round(sin(alp)*300);
  line(200,480-200,200-dx2,480+dy2-200);
  line(200,480-200,640,480-200);
  line(200,480-200,200,0);

  setcolor(green);
  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*b.y);
  dx2:=round(sin(alp)*b.y);
  line(200+a.x-dx1,280-a.z+dy1,200+b.x-dx2,280-b.z+dy2);

  dy1:=round(cos(alp)*b.y);
  dx1:=round(sin(alp)*b.y);
  dy2:=round(cos(alp)*c.y);
  dx2:=round(sin(alp)*c.y);
  line(200+b.x-dx1,280-b.z+dy1,200+c.x-dx2,280-c.z+dy2);

  dy1:=round(cos(alp)*c.y);
  dx1:=round(sin(alp)*c.y);
  dy2:=round(cos(alp)*d.y);
  dx2:=round(sin(alp)*d.y);
  line(200+c.x-dx1,280-c.z+dy1,200+d.x-dx2,280-d.z+dy2);

  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*c.y);
  dx2:=round(sin(alp)*c.y);
  line(200+a.x-dx1,280-a.z+dy1,200+c.x-dx2,280-c.z+dy2);

  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*d.y);
  dx2:=round(sin(alp)*d.y);
  line(200+a.x-dx1,280-a.z+dy1,200+d.x-dx2,280-d.z+dy2);

  dy1:=round(cos(alp)*b.y);
  dx1:=round(sin(alp)*b.y);
  dy2:=round(cos(alp)*d.y);
  dx2:=round(sin(alp)*d.y);
  line(200+b.x-dx1,280-b.z+dy1,200+d.x-dx2,280-d.z+dy2);
  ca:=readkey;
  if ca = 'w' then alpha:=alpha+1;
  if ca = 's' then alpha:=alpha-1;
  if alpha=361 then alpha:=1;
  if alpha=-1 then alpha:=359;
  cleardevice;

  until ca='q';
  closegraph;
  clrscr;
  writeln('1 - Save data');
  writeln('2 - Go to main menu');
  writeln('3 - EXIT');
  readln(r);
  if r=1 then
  begin
    writeln('enter name of save');
    readln(s);
    f1.q:=a; f1.w:=b; f1.e:=c; f1.r:=d; f1.t:=alpha;
    assign(f,s);
    rewrite(f);
    write(f,f1);
  end;
 until r=3;
END.
Анна
ап sad.gif
Анна
Вот собственно:

uses crt,graph;

type
  coords = record
  x,y,z : integer;
end;

type
  save = record
  q,w,e,r : coords;
  t : integer;
end;

var a, b, c, d, n, m : coords;
    alpha, r, dx1, dy1, dx2, dy2, x, y, z, mx, my, mz, gm, gd : integer;
    alp : real;
    ca  : char;
    s   : string;
    f   : file of save;
    f1  : save;

BEGIN
repeat
  clrscr;
  gm:=detect;


  a.x:=0;
  a.y:=0;
  a.z:=0;

  b.x:=100;
  b.y:=0;
  b.z:=0;

  c.x:=0;
  c.y:=0;
  c.z:=100;

  d.x:=0;
  d.y:=100;
  d.z:=0;

  n.x:=0;
  n.y:=100;
  n.z:=100;

  m.x:=100;
  m.y:=0;
  m.z:=100;

  initgraph(gm,gd,'');
  repeat
  alp:=pi/180*alpha;
  setcolor(white);
  str(alpha,s);
  outtextxy(0,0,s);
  setcolor(yellow);
  dy2:=round(cos(alp)*300);
  dx2:=round(sin(alp)*300);
  line(200,480-200,200-dx2,480+dy2-200);
  line(200,480-200,640,480-200);
  line(200,480-200,200,0);

  setcolor(green);
  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*b.y);
  dx2:=round(sin(alp)*b.y);
  line(200+a.x-dx1,280-a.z+dy1,200+b.x-dx2,280-b.z+dy2);


  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*c.y);
  dx2:=round(sin(alp)*c.y);
  line(200+a.x-dx1,280-a.z+dy1,200+c.x-dx2,280-c.z+dy2);

  dy1:=round(cos(alp)*a.y);
  dx1:=round(sin(alp)*a.y);
  dy2:=round(cos(alp)*d.y);
  dx2:=round(sin(alp)*d.y);
  line(200+a.x-dx1,280-a.z+dy1,200+d.x-dx2,280-d.z+dy2);

  dy1:=round(cos(alp)*b.y);
  dx1:=round(sin(alp)*b.y);
  dy2:=round(cos(alp)*d.y);
  dx2:=round(sin(alp)*d.y);
  line(200+b.x-dx1,280-b.z+dy1,200+d.x-dx2,280-d.z+dy2);




  dy1:=round(cos(alp)*d.y);
  dx1:=round(sin(alp)*d.y);
  dy2:=round(cos(alp)*n.y);
  dx2:=round(sin(alp)*n.y);
  line(200+d.x-dx1,280-d.z+dy1,200+n.x-dx2,280-n.z+dy2);

  dy1:=round(cos(alp)*b.y);
  dx1:=round(sin(alp)*b.y);
  dy2:=round(cos(alp)*m.y);
  dx2:=round(sin(alp)*m.y);
  line(200+b.x-dx1,280-b.z+dy1,200+m.x-dx2,280-m.z+dy2);


  dy1:=round(cos(alp)*c.y);
  dx1:=round(sin(alp)*c.y);
  dy2:=round(cos(alp)*n.y);
  dx2:=round(sin(alp)*n.y);
  line(200+c.x-dx1,280-c.z+dy1,200+n.x-dx2,280-n.z+dy2);

  dy1:=round(cos(alp)*c.y);
  dx1:=round(sin(alp)*c.y);
  dy2:=round(cos(alp)*m.y);
  dx2:=round(sin(alp)*m.y);
  line(200+c.x-dx1,280-c.z+dy1,200+m.x-dx2,280-m.z+dy2);

  dy1:=round(cos(alp)*n.y);
  dx1:=round(sin(alp)*n.y);
  dy2:=round(cos(alp)*m.y);
  dx2:=round(sin(alp)*m.y);
  line(200+n.x-dx1,280-n.z+dy1,200+m.x-dx2,280-m.z+dy2);






  ca:=readkey;
  if ca = 'w' then alpha:=alpha+1;
  if ca = 's' then alpha:=alpha-1;
  if alpha=361 then alpha:=1;
  if alpha=-1 then alpha:=359;
  cleardevice;

  until ca='q';
  closegraph;
  clrscr;
  writeln('1 - Save data');
  writeln('2 - Go to main menu');
  writeln('3 - EXIT');
  readln(r);
  if r=1 then
  begin
    writeln('enter name of save');
    readln(s);
    f1.q:=a; f1.w:=b; f1.e:=c; f1.r:=d; f1.t:=alpha;
    assign(f,s);
    rewrite(f);
    write(f,f1);
  end;
 until r=3;
END.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.