uses Graph,crt;
{Объявление констант}
const
yy=80;
st=yy*0.7071;
tops: array[0..5,0..2] of real = {Зададим матрицу координат вершин октаэдра}
((0,0,0),
(0,2*yy,0),
(st,yy,st),
(st,yy,-st),
(-st,yy,-st),
(-st,yy,st));
ridge: array[0..11,0..1] of integer = {Зададим матрицу ребер октаэдра }
((0,2),(0,3),(0,4),(0,5),(1,2),(1,3),(1,4),(1,5),(2,3),(3,4),(4,5),(5,2));
f:real=45*Pi/180; {Назначение угла поворота вокруг оси OX}
q:real=35.26*Pi/180; {Назначение угла поворота вокруг оси OY}
{Объявление переменных}
var
turn :real; {Обозначение угла поворота вокруг произвольной оси}
sx,sy,sx1,sy1,p,gd,gm,i: integer; {вспомогательные переменные}
ch:char; {код нажатой клавиши}
tX,tY,tZ:real; {вспомогательные переменные}
coordPr: array[0..5,0..2] of real; {матрица изометрических координат}
{процедура нахождения изометрических координат октаэдра }
Procedure Proek;
Begin
for p:=0 to 5 do {цикл от 0 до 5}
begin
coordPr[p,0]:=tops[p,0]*cos(f)+ tops[p,2]*sin(f);
coordPr[p,2]:=0;
coordPr[p,1]:= tops[p,0]*sin(f)*sin(q)+ tops[p,1]*cos(q)- tops[p,2]*cos(f)*sin(q);
end;
End;
{процедура рисования контура октаэдра }
procedure draw(color:byte);
begin
{в цикле от 0 до 11 соединяем точки вершин октаэдра по номерам ребер. Точки строим относительно центра экрана}
for p:=0 to 11 do begin
sx:=round(coordPr[ridge[p,0],0]+getmaxx div 2);
sx1:=round(coordPr[ridge[p,1],0]+getmaxx div 2);
sy:=round(getmaxy div 2-coordPr[ridge[p,0],1]);
sy1:=round(getmaxy div 2-coordPr[ridge[p,1],1]);
setcolor(color); {задаем цвет}
line(SX,SY,sx1,sy1); {проводим линии ребер}
end;
end;
{процедура поворота вокруг оси OZ}
procedure rotateOZ;
begin
for i:=0 to 5 do begin {в цикле находим новые координаты октаэдра }
tX := tops[i,0] * COS(turn) - tops[i,1] * SIN(turn);
tY := tops[i,0] * SIN(turn) + tops[i,1] * COS(turn);
tops[i,0]:=tX;
tops[i,1] :=tY;
end;
end;
{процедура поворота вокруг оси OX}
procedure rotateOX;
begin
for i:=0 to 5 do begin {в цикле находим новые координаты октаэдра }
tY := tops[i,1] * COS(turn) - tops[i,2] * SIN(turn);
tZ := tops[i,1] * SIN(turn) + tops[i,2] * COS(turn);
tops[i,1]:=tY;
tops[i,2] :=tZ;
end;
end;
{ процедура поворота вокруг оси OY}
procedure rotateOY;
begin
for i:=0 to 5 do begin {в цикле находим новые координаты октаэдра }
tX := tops[i,0] * COS(turn) + tops[i,2] * SIN(turn);
tZ := -tops[i,0] * SIN(turn) + tops[i,2] * COS(turn);
tops[i,0]:=tX;
tops[i,2] :=tZ;
end;
end;
{процедура рисования изометрических осей}
procedure Axes;
var l:integer;
begin
SetColor(2); {устанавливаю цвет}
l:=GetMaxY div 2;
{рисуем ось OY вертикально вверх}
line(GetMaxX div 2,GetMaxY div 2,GetMaxX div 2,0);
{рисуем ось OX под углом 120 с оси OY}
line(GetMaxX div 2,GetMaxY div 2,GetMaxX div 2 + round(0.866*l),GetMaxY div 2 + round(0.5*l));
{рисуем ось OX под углом -1200 с оси OY}
line(GetMaxX div 2,GetMaxY div 2,GetMaxX div 2 - round(0.866*l),GetMaxY div 2 + round(0.5*l));
end;
{основная программа}
begin
gm:=VgaHi; {определяю графический режим}
gd:=detect; {определяю графический драйвер}
initgraph(gd,gm,'c:\TP7\BGI'); {инициалиализирую графику }
turn := 0.05; {задаю угол поворота }
{надписи осей}
OutTextXY(getmaxx div 2 + 10,10,'Y');
OutTextXY(GetMaxX div 2 + round(0.866*(GetMaxY div 2)) + 10,GetMaxY div 2 + round(0.5*(GetMaxY div 2))-10,'Z');
OutTextXY(GetMaxX div 2 - round(0.866*(GetMaxY div 2))-10,GetMaxY div 2 + round(0.5*(GetMaxY div 2))-10,'X');
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
repeat {цикл с постусловием}
ch:=readkey; {запоминаю код нажатой клавиши}
case ch of {оператор выбора}
#49:begin {если нажата <1>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(5000); {задержка 5000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
rotateOX; {вызов процедуры rotateOX}
{если нажата любая клавиша, то выход их цикла}
if keypressed then break;
until ch=#27;
end;
#50:begin {если нажата <2>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(5000); {задержка 5000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
rotateOY; {вызов процедуры rotateOY}
{если нажата любая клавиша, то выход их цикла}
if keypressed then break;
until ch=#27;
end;
#51:begin {если нажата <3>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(5000); {задержка 5000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
rotateOZ; {вызов процедуры rotateOZ}
{если нажата любая клавиша, то выход их цикла}
if keypressed then break;
until ch=#27;
end;
#52:begin {если нажата <4>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{увеличение масштаба по оси X}
for p:=0 to 5 do tops[p,0]:=tops[p,0]*3;
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{уменьшение масштаба по оси X}
for p:=0 to 5 do tops[p,0]:= tops[p,0]/3;
{если нажата любая клавиша, то выход их цикла}
if keypressed then break
until ch=#27;
end;
#53:begin {если нажата <5>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{увеличение масштаба по оси Y}
for p:=0 to 5 do tops[p,1]:= tops[p,1]*2;
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{ уменьшение масштаба по оси Y}
for p:=0 to 5 do tops[p,1]:= tops[p,1]/2;
{если нажата любая клавиша, то выход их цикла}
if keypressed then break
until ch=#27;
end;
#54:begin {если нажата <6>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{увеличение масштаба по оси Z}
for p:=0 to 5 do tops[p,2]:= tops[p,2]*3;
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{уменьшение масштаба по оси Z}
for p:=0 to 5 do tops[p,2]:= tops[p,2]/3;
{если нажата любая клавиша, то выход их цикла} if keypressed then break
until ch=#27;
end;
#55:begin {если нажата <7>}
Repeat {выполнять, пока не нажат <enter>}
Axes; {вызываю процедуру Axes}
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{увеличение масштаба по трем осям }
for p:=0 to 5 do begin
tops[p,0]:=tops[p,0]/2;
tops[p,1]:=tops[p,1]/2;
tops[p,2]:=tops[p,2]/2;
end;
Proek; {вызываю процедуру Proek}
draw(15); {вызываю процедуру draw (цвет белый)}
delay(50000); {задержка 50000 мс}
draw(0); {вызываю процедуру draw (цвет экрана)}
{уменьшение масштаба по трем осям}
for p:=0 to 5 do begin
tops[p,0]:=tops[p,0]*2;
tops[p,1]:=tops[p,1]*2;
tops[p,2]:=tops[p,2]*2;
end;
{если нажата любая клавиша, то выход их цикла}
if keypressed then break
until ch=#27;
end;
end;
until ch=#13;
closegraph; {закрываем графический режим}
end.