Программирование математических объектов — страница 2
Обновлено
[ y ]
[ z ]
используются вектора вида
[ x ]
[ y ]
[ z ]
[ 1 ]
а вместо произвольных матриц 3x3 используются матрицы 4x4 такого вида:
[ a b c d ]
[ e f g h ]
[ i j k l ]
[ 0 0 0 1 ]
Видно, что если d = h = l = 0, то в результате применения всех операций получается то же самое, что и для матриц 3x3.
Матрица параллельного переноса теперь определяется как
[ 1 0 0 dx ]
[ 0 1 0 dy ]
[ 0 0 1 dz ]
[ 0 0 0 1 ]
Матрицу масштабирования можно определить и для матриц 3x3, и для матриц 4x4:
[ kx 0 0 ] [ kx 0 0 0 ]
[ 0 ky 0 ] или [ 0 ky 0 0 ]
[ 0 0 kz ] [ 0 0 kz 0 ]
[ 0 0 0 1 ]
где kx, ky, kz - коэффициенты масштабирования по соответствующим осям.
Таким образом, получаем следующее. Любое нужное нам преобразование пространства можно задать матрицей 4x4 определенной структуры, разной для разных преобразований. Результат последовательного выполнений нескольких преобразований совпадает с результатом одного преобразования T, которое также задается матрицей 4x4, вычисляемой как произведение матриц всех этих преобразований. Важен порядок умножения, так как A*B B*A. Результат применения преобразования T к вектору [ x y z ] считается как результат умножения матрицы T на вектор [ x y z 1 ].
Докажем на примере, что A*B B*A. Пусть A - матрица переноса, B - поворота. Если сначала перенести объект, а потом повернем относительно центра координат (это будет B*A), то результат не будет соответствовать результату, при котором сначала объект поворачивают, а затем переносят (A*B).
5.2 Создание одноцветного треугольника
Изображение треугольника на экране - набор горизонтальных отрезков, причем из-за того, что треугольник - фигура выпуклая, каждой строке экрана соответствует не более одного отрезка. Поэтому достаточно обойти все строки экрана, с которыми пересекается треугольник, (то есть, от минимального до максимального значения (y) для вершин треугольника), и нарисовать соответствующие горизонтальные отрезки.
Нужно отсортировать вершины так, чтобы вершина A была верхней, C - нижней, тогда min_y = A.y, max_y = C.y, и надо обойти все линии от min_y до max_y. Рассмотрим какую-то линию sy, A.y <= sy <= C.y. Если sy < B.y, то она пересекает стороны AB и AC; если sy >= B.y - то стороны BC и AC. Известны координаты всех вершин, поэтому можно написать уравнения сторон и найти пересечение нужной стороны с прямой y = sy. Получим два конца отрезка. Так как не известно, какой из них левый, а какой правый, нужно сравним их координаты по x и обменяем значения, если нужно. Рисуя этот отрезок, повторяя процедуру для каждой строки - получаем треугольник.
Рассматривая более подробно пересечения прямой
y = sy (текущей строки) и стороны треугольника, например AB, Получим уравнение прямой AB в форме x = k*y+b:
x = A.x+(y-A.y)*(B.x-A.x)/(B.y-A.y)
Теперь надо подставить известное для текущей прямой значение y = sy:
x = A.x+(sy-A.y)*(B.x-A.x)/(B.y-A.y)
Для других сторон пересечение ищется совершенно точно так же. Например:
// ...
// здесь сортируем вершины (A,B,C)
// ...
for sy = A.y to C.y begin
x1 = A.x + (sy - A.y) * (C.x - A.x) / (C.y - A.y);
if (sy < B.y)Then
x2 = A.x + (sy - A.y) * (B.x - A.x) / (B.y - A.y);
else
x2 = B.x + (sy - B.y) * (C.x - B.x) / (C.y - B.y);
if (x1 > x2) Then
begin
tmp = x1; x1 = x2; x2 = tmp;
end;
drawHorizontalLine(sy, x1, x2);
end;
Необходимо защититься от случая, когда B.y = C.y - в этом (и только этом, потому как если C.y = A.y, то треугольник пустой и рисовать его не нужно, или можно рисовать горизонтальную линию; а если B.y = A.y, то sy >= A.y и до деления на B.y - A.y не дойдет) случае произойдет попытка деления на ноль.
// ...
// здесь сортируем вершины (A,B,C)
// ...
for sy = A.y to C.y begin
x1 = A.x + (sy - A.y) * (C.x - A.x) / (C.y - A.y);
if (sy < B.y)
x2 = A.x + (sy - A.y) * (B.x - A.x) / (B.y - A.y);
else begin
if (C.y == B.y)
x2 = B.x;
else
x2 = B.x + (sy - B.y) * (C.x - B.x) / (C.y - B.y);
end;
if (x1 > x2)Then
begin
tmp = x1; x1 = x2; x2 = tmp;
drawHorizontalLine(sy, x1, x2);
end;
// ...
Здесь drawHorizontalLine(sy, x1, x2) - горизонтальная линия. Её создание не представляет сложности и код будетвыглядеть так.
//...
For i:=x1 to x2 do
PutPixel(i,sy,Color);
//...
6. Программа
unit graph3;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DXClass, DXDraws, StdCtrls,graph, Menus,graph3D,figures, Buttons;
const Mode:Word=0;
type TLab = class(TForm)
Vid: TDXDraw;
Timer: TDXTimer;
Enter: TButton;
Menu: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
N10: TMenuItem;
Space: TButton;
Box1: TComboBox;
Label1: TLabel;
OK: TButton;
Cancel: TButton;
Label6: TLabel;
BCube: TBitBtn;
BSide: TBitBtn;
Box6: TComboBox;
Label7: TLabel;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject; LagCount: Integer);
procedure VidMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EnterClick(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure SpaceClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CancelClick(Sender: TObject);
procedure OKClick(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure BCubeClick(Sender: TObject);
procedure BSideClick(Sender: TObject);
procedure N6Click(Sender: TObject);
private
public
end;
var Lab: TLab;
implementation
{$R *.DFM}
const ScreenX:Word=640;
ScreenY:Word=480;
x1:integer=0;
y1:integer=0;
White=$FFFFFF;
View:Boolean=False;
Figure:Word=1;
Accept:Boolean=True;
sv:Word=0;
var c:char;S,SS,TMP:PPl;t:PTexture;
CS,CO,CC,CSc,CL:Word;Rot:TRot;
x0,y0,x2,y2:integer;r:Single;
Blue,Red,Yelow,M,N,SC:Word;
Keys:array[1..255]of Boolean;
Input:array[1..12]of procedure (x,y:integer;var E:Boolean);
Bol:Boolean;Option:array[1..5] of String;
o:array[1..MaxSide]of TPoint;
w:array[1..2]of TPoint;tmp_o:TPoint;
cx,cy:Word;oc:TPoint;ClicCub:array[0..MaxSide]of Boolean;
procedure LoadObject(Name:String;var Obj:PObj);
var f1:file of TPoint; a:TSides;
f2:file of Word;
S,Tmp:TPoint;i,j:word;Name2:String;
B:Boolean;
begin
For i:=1 to Length (Name)-4 do begin
Name2:=Name2+Name[i];
end;
Name:=Name2;
Assign(f2,Name+'.res');
Reset(f2);
Read(f2,Obj^.Count);
close(f2);
Assign(f1,Name+'.dat');
Reset(f1);
Read(f1,Obj^.o);
For i:=1 to Obj^.Count do
New(Obj^.Side[i],Create(Obj^.o.x,Obj^.o.y,Obj^.o.z,0,0,0,a));
For i:=1 to Obj^.Count do begin
inc(CS);
if(i mod 2<>0)Then
T:=ColorText(RGB(100+Random(155),100+Random(155),100+Random(155)),GMT)
else T:=T;
Obj^.Side[i]^.Texture:=T;
Obj^.Side[i]^.Mode:=Mode;
Obj^.Side[i]^.Alpha:=0;
Read(f1,S);
For j:=1 to 3 do
begin
Read(f1,S);
Obj^.Side[i]^.S[j]:=S;
SS^[i,j]:=S;
end;
end;
close(f1);
end;
procedure SaveObject(Name:String;var Obj:PObj);
var f1:file of TPoint;
f2:file of Word;B:Boolean;
S:TPoint;i,j:word;Name2:String;
begin
B:=False;
For i:=1 to Length(Name) do
if(Name[i]='.')Then B:=True;
if(B=True)Then begin
For i:=1 to Length(Name)-4 do begin
Name2:=Name2+Name[i];
end;
Name:=Name2;
end;
Assign(f2,Name+'.res');
Rewrite(f2);
Reset(f2);
Write(f2,Obj^.Count);
close(f2);
Assign(f1,Name+'.dat');
Rewrite(f1);
Reset(f1);
Write(f1,Obj^.o);
For i:=1 to Obj^.Count do begin
Obj^.Side[i]^.o:=tmp_o;
S:=Obj^.Side[i]^.o;
Write(f1,S);
For j:=1 to 3 do
begin
S:=Obj^.Side[i]^.S[j];
Write(f1,S);
end;
end;
close(f1);
end;
procedure CreateTMP(var Obj:PObj);
var i,j,k:Word;
begin
Obj^.o.x:=0;Obj^.o.y:=0;Obj^.o.z:=100;
For i:=1 to Obj^.Count do
begin
tmp_o:=Obj^.Side[i]^.o;
Obj^.Side[i]^.o:=o[i];
For j:=1 to 3 do
Obj^.Side[i]^.S[j]:=S^[i,j];
end;
end;
procedure ShowSide;
var i,j,k,cx,cy:Word;tmp:TPoint;
begin
Lab.Vid.Surface.Fill(0);
myForm(GetMaxX,GetMaxY);
For i:=1 to CS do begin
Line(Trunc(SS^[i,1].x),Trunc(SS^[i,1].y),Trunc(SS^[i,2].x),Trunc(SS^[i,2].y),White);
Line(Trunc(SS^[i,2].x),Trunc(SS^[i,2].y),Trunc(SS^[i,3].x),Trunc(SS^[i,3].y),White);
Line(Trunc(SS^[i,3].x),Trunc(SS^[i,3].y),Trunc(SS^[i,1].x),Trunc(SS^[i,1].y),White);
Line(Trunc(SS^[i,1].x),Trunc(SS^[i,1].z),Trunc(SS^[i,2].x),Trunc(SS^[i,2].z),White);
Line(Trunc(SS^[i,2].x),Trunc(SS^[i,2].z),Trunc(SS^[i,3].x),Trunc(SS^[i,3].z),White);
Line(Trunc(SS^[i,3].x),Trunc(SS^[i,3].z),Trunc(SS^[i,1].x),Trunc(SS^[i,1].z),White);
Line(Trunc(SS^[i,1].z*r),Trunc(SS^[i,1].y),Trunc(SS^[i,2].z*r),Trunc(SS^[i,2].y),White);
Line(Trunc(SS^[i,2].z*r),Trunc(SS^[i,2].y),Trunc(SS^[i,3].z*r),Trunc(SS^[i,3].y),White);
Line(Trunc(SS^[i,3].z*r),Trunc(SS^[i,3].y),Trunc(SS^[i,1].z*r),Trunc(SS^[i,1].y),White);
if(ClicCub[i]=True)Then begin
Line(Trunc(SS^[i,1].z),Trunc(SS^[i,1].y),Trunc(SS^[i,2].z),Trunc(SS^[i,1].y),White);
Line(Trunc(SS^[i,2].z),Trunc(SS^[i,1].y),Trunc(SS^[i,1].z),Trunc(SS^[i,3].y),White);
end;
end;
S[CS]:=SS[CS];
cx:=GMX div 2;
cy:=GMY div 2+1;
For i:=1 to 3 do
begin
S^[CS,i].x:=S^[CS,i].x-cx+dF;
S^[CS,i].y:=cy-S^[CS,i].y-dF;
S^[CS,i].z:=S^[CS,i].z-cx-dF;
end;
end;
procedure CreateSide(var Obj:PObj);
var cx,cy,i,j,k:Word;
begin
r:=1;
For i:=1 to Obj^.Count do
S[i]:=Obj^.Side[i]^.S;
TMP:=S;
Lab.Vid.Surface.Fill(0);
myForm(GetMaxX,GetMaxY);
cx:=GMX div 2;
cy:=GMY div 2+1;
For j:=1 to CS do
For i:=1 to 3 do
begin
TMP^[j,i].x:=TMP^[j,i].x-cx+dF;
TMP^[j,i].y:=cy-TMP^[j,i].y-dF;
TMP^[j,i].z:=TMP^[j,i].z-cx-dF;
end;
For i:=1 to CS do begin
Line(Trunc(TMP^[i,1].x),Trunc(TMP^[i,1].y),Trunc(TMP^[i,2].x),Trunc(TMP^[i,2].y),White);
Line(Trunc(TMP^[i,2].x),Trunc(TMP^[i,2].y),Trunc(TMP^[i,3].x),Trunc(TMP^[i,3].y),White);
Line(Trunc(TMP^[i,3].x),Trunc(TMP^[i,3].y),Trunc(TMP^[i,1].x),Trunc(TMP^[i,1].y),White);
Line(Trunc(TMP^[i,1].x),Trunc(TMP^[i,1].z),Trunc(TMP^[i,2].x),Trunc(TMP^[i,2].z),White);
Line(Trunc(TMP^[i,2].x),Trunc(TMP^[i,2].z),Trunc(TMP^[i,3].x),Trunc(TMP^[i,3].z),White);
Line(Trunc(TMP^[i,3].x),Trunc(TMP^[i,3].z),Trunc(TMP^[i,1].x),Trunc(TMP^[i,1].z),White);
Line(Trunc(TMP^[i,1].z*r),Trunc(TMP^[i,1].y),Trunc(TMP^[i,2].z*r),Trunc(TMP^[i,2].y),White);
Line(Trunc(TMP^[i,2].z*r),Trunc(TMP^[i,2].y),Trunc(TMP^[i,3].z*r),Trunc(TMP^[i,3].y),White);
Line(Trunc(TMP^[i,3].z*r),Trunc(TMP^[i,3].y),Trunc(TMP^[i,1].z*r),Trunc(TMP^[i,1].y),White);
end;
Flip(Lab.Vid);
end;
procedure LoadSide(var Obj:PObj);
var i,j,k:Word;TMP:PPL;
begin
r:=1;
For i:=1 to Obj^.Count do
S[i]:=Obj^.Side[i]^.S;
SS^:=S^;
Lab.Vid.Surface.Fill(0);
myForm(GetMaxX,GetMaxY);
For j:=1 to CS do
For i:=1 to 3 do
begin
SS^[j,i].x:=SS^[j,i].x+cx-dF;
SS^[j,i].y:=cy-SS^[j,i].y-dF;
SS^[j,i].z:=SS^[j,i].z+cx+dF;
end;
For i:=1 to CS do begin
Line(Trunc(SS^[i,1].x),Trunc(SS^[i,1].y),Trunc(SS^[i,2].x),Trunc(SS^[i,2].y),White);
Line(Trunc(SS^[i,2].x),Trunc(SS^[i,2].y),Trunc(SS^[i,3].x),Trunc(SS^[i,3].y),White);
Line(Trunc(SS^[i,3].x),Trunc(SS^[i,3].y),Trunc(SS^[i,1].x),Trunc(SS^[i,1].y),White);
Line(Trunc(SS^[i,1].x),Trunc(SS^[i,1].z),Trunc(SS^[i,2].x),Trunc(SS^[i,2].z),White);
Line(Trunc(SS^[i,2].x),Trunc(SS^[i,2].z),Trunc(SS^[i,3].x),Trunc(SS^[i,3].z),White);
Line(Trunc(SS^[i,3].x),Trunc(SS^[i,3].z),Trunc(SS^[i,1].x),Trunc(SS^[i,1].z),White);
Line(Trunc(SS^[i,1].z*r),Trunc(SS^[i,1].y),Trunc(SS^[i,2].z*r),Trunc(SS^[i,2].y),White);
Line(Trunc(SS^[i,2].z*r),Trunc(SS^[i,2].y),Trunc(SS^[i,3].z*r),Trunc(SS^[i,3].y),White);
Line(Trunc(SS^[i,3].z*r),Trunc(SS^[i,3].y),Trunc(SS^[i,1].z*r),Trunc(SS^[i,1].y),White);
end;
Flip(Lab.Vid);
end;
procedure InPut1(x,y:integer;var E:Boolean);
var i,j:integer;B:Boolean;
begin
if(sv=0)Then begin
o[CS].x:=0;
o[CS].y:=0;
o[CS].z:=0;
end;
if(M<sv)Then begin
PutPixel(x,y,Yelow);
Flip(Lab.Vid);
if(x<cx)and(y<cy)Then
begin
o[CS].x:=x-cx+dF;
o[CS].y:=cy-y-dF;
end
else if(x>cx)and(y<cy)Then
begin
o[CS].z:=x-cx-dF;
o[CS].y:=cy-y-dF;
end
else if(x<cx)and(y>cy)Then
begin
o[CS].x:=x-cx+dF;
o[CS].z:=x-cx-dF;
end
else begin
ShowMessage('Эта четверть не является плоскостью проекций!');
E:=True;
end;
inc(M);
end
else
if (M<6+sv)Then begin
if(N>3)Then N:=0;
if(x>cx)and(y>cy)Then
else
if(N=0)Then begin
x0:=x;y0:=y;x1:=0;y1:=0;
N:=1;
end;
if(x<cx)and(y<cy)Then
begin
SS^[CS,N].x:=x;
SS^[CS,N].y:=y;
r:=1;
end
else if(x>cx)and(y<cy)Then
begin
SS^[CS,N].z:=x;
SS^[CS,N].y:=y;
r:=1;
end
else if(x<cx)and(y>cy)Then
begin
SS^[CS,N].x:=x;
SS^[CS,N].z:=y;
r:=GetMaxX/GetMaxY;
end
else begin
ShowMessage('Эта четверть не является плоскостью проекций!');
E:=True;
end;
if(E=False)Then begin
x2:=X;y2:=Y;
if(x1<>0)and(y1<>0)Then begin
Line(x0,y0,x2,y2,Red);
Line(x1,y1,x2,y2,Red);
end
else putpixel(x2,y2,Red);
Flip(Lab.Vid);
x1:=x2;y1:=y2;
For i:=1 to CS-1 do
For j:=1 to 3 do
begin
if(SS^[CS,N].x+o[CS].x>=SS^[i,j].x+o[i].x-2)and(SS^[CS,N].x+o[CS].x<=SS^[i,j].x+o[i].x+2)
and(SS^[CS,N].y+o[CS].y>=SS^[i,j].y+o[i].y-2)and(SS^[CS,N].y+o[CS].y<=SS^[i,j].y+o[i].y+2)
and(SS^[CS,N].z+o[CS].z>=SS^[i,j].z+o[i].z-2)and(SS^[CS,N].z+o[CS].z<=SS^[i,j].z+o[i].z+2)Then Accept:=True;
end;
inc(N);
inc(M);
end;
end;
if(M=6+sv)and(Accept=True)Then begin
M:=0;N:=0;
ClicCub[CS]:=False;
ShowSide;
Flip(Lab.Vid);
New(Scene^.Camera[CC]^.Obj[CO]^.Side[CS],Create(0,0,100,o[CS].x,o[CS].y,o[CS].z,S^[CS]));
if(CS mod 2<>0)Then
T:=ColorText(RGB(100+Random(155),100+Random(155),100+Random(155)),GMT)
else T:=T;
Scene^.Camera[CC]^.Obj[CO]^.Side[CS]^.Texture:=T;
Scene^.Camera[CC]^.Obj[CO]^.Side[CS]^.Mode:=Mode;
Scene^.Camera[CC]^.Obj[CO]^.Side[CS]^.Alpha:=0;
Accept:=False;
inc(CS);
end
else if(M=6+sv)and(Accept=False)Then begin
SS[CS]:=SS[CS-1];
SS[CS]:=SS[CS-1];
SS[CS]:=SS[CS-1];
M:=0;N:=0;
ShowSide;
Flip(Lab.Vid);
end;
end;
procedure InPut2(x,y:integer;var E:Boolean);
var i,j:integer;o:TPoint;Party:Single;tmp:Single;
begin
if(N<sv)Then begin
if(x<cx)and(y<cy)Then
begin
oc.x:=x-cx+dF;
oc.y:=cy-y-dF;
end
else if(x>cx)and(y<cy)Then
begin
oc.z:=x-cx-dF;
oc.y:=cy-y-dF;
end
else if(x<cx)and(y>cy)Then
begin
oc.x:=x-cx+dF;
oc.z:=x-cx-dF;
end
else begin
ShowMessage('Эта четверть не является плоскостью проекций!');
E:=True;
end;
if(E=False)Then begin
PutPixel(x,y,Yelow);
Flip(Lab.Vid);
inc(N);
end;
end
else
if(N<2+sv)and(N>sv-1)Then begin
if(N=sv)Then begin
x0:=x;y0:=y;
end;
x1:=x;y1:=y;
Line(x0,y0,x1,y1,Red);
Flip(Lab.Vid);
x0:=x;y0:=y;
inc(N);
if(x>cx)and(y>cy)Then begin
ShowMessage('Эта четверть не является плоскостью проекций!');
E:=True;
end
else begin
w[N-sv].x:=x;
w[N-sv].y:=y;
end;
end;
if(N=2+sv)Then begin
if(abs(w[N-sv].x-w[N-sv-1].x)/2<=abs(w[N-sv].y-w[N-sv-1].y)/2)Then Party:=abs(w[N-sv].x-w[N-sv-1].x)
else Party:=abs(w[N-sv].y-w[N-sv-1].y);
if(w[N-sv].x<cx)and(w[N-sv].y<cy)Then begin
o.x:=(w[N-sv].x+w[N-sv-1].x)/2;
o.y:=(w[N-sv].y+w[N-sv-1].y)/2;
o.z:=cx+Party/2+dF;
end
else if(w[N-sv].x>cx)and(w[N-sv-1].y<cy)Then begin
o.x:=cx-Party/2-dF;
o.y:=(w[N-sv].y+w[N-sv-1].y)/2;
o.z:=(w[N-sv].x+w[N-sv-1].x)/2;
end
else if(w[N-sv].x<cx)and(w[N-sv].y>cy)Then begin
o.x:=(w[N-sv].x+w[N-sv-1].x)/2;
o.y:=cy-Party/2-dF;
o.z:=(w[N-sv].y+w[N-sv-1].y)/2;
end;
r:=1;
SS^[CS,1].x:=o.x-Party/2;SS^[CS,1].y:=o.y+Party/2;SS^[CS,1].z:=o.z+Party/2;
SS^[CS,2].x:=o.x+Party/2;SS^[CS,2].y:=o.y+Party/2;SS^[CS,2].z:=o.z+Party/2;
SS^[CS,3].x:=o.x-Party/2;SS^[CS,3].y:=o.y-Party/2;SS^[CS,3].z:=o.z-Party/2;
SS^[CS+1,1].x:=o.x+Party/2;SS^[CS+1,1].y:=o.y-Party/2;SS^[CS+1,1].z:=o.z-Party/2;
SS^[CS+1,2].x:=o.x+Party/2;SS^[CS+1,2].y:=o.y+Party/2;SS^[CS+1,2].z:=o.z+Party/2;
SS^[CS+1,3].x:=o.x+Party/2;SS^[CS+1,3].y:=o.y+Party/2;SS^[CS+1,3].z:=o.z-Party/2;
SS^[CS+2,1].x:=o.x-Party/2;SS^[CS+2,1].y:=o.y+Party/2;SS^[CS+2,1].z:=o.z+Party/2;
SS^[CS+2,2].x:=o.x-Party/2;SS^[CS+2,2].y:=o.y-Party/2;SS^[CS+2,2].z:=o.z-Party/2;
SS^[CS+2,3]:=SS^[CS+1,1];
o.x:=o.x-cx+dF;
o.y:=cy-o.y-dF;
o.z:=o.z-cx-dF;
Scene^.Camera[CC]^.Obj[CO]^.Done;
Scene^.Camera[CC]^.Done;
Scene^.Done;
New(Cube,Create(0,0,100,o.x,o.y,o.z,Party,T,Mode,0));
Scene^.Camera[CC]^.ADD(CO,CO+1);
For i:=1 to Scene^.Camera[CC]^.Obj[CO]^.Count do
begin
For j:=1 to 3 do
S[i,j]:=Scene^.Camera[CC]^.Obj[CO]^.Side[i]^.S[j];
if(i mod 2<>0)Then
T:=ColorText(RGB(100+Random(155),100+Random(155),100+Random(155)),GMT)
else T:=T;
Scene^.Camera[CC]^.Obj[CO]^.Side[i]^.Texture:=T;
Scene^.Camera[CC]^.Obj[CO]^.Side[i]^.Mode:=Mode;
end;
For i:=CS to CS+12 do
ClicCub[i]:=True;
CS:=CS+12;
N:=0;
Scene^.Camera[CC]^.Obj[CO]^.Done;
Scene^.Camera[CC]^.Done;
Scene^.Done;
ShowSide;
Flip(Lab.Vid);
end;
end;
procedure Data;
var i,j:Word;
begin
New(S);
New(SS);
GetMaxX:=Lab.Vid.Width-1;
GetMaxY:=Lab.Vid.Height-1;
M:=0;N:=0;Rot:=YRot;Bol:=False;
GMX:=Lab.Vid.Width;
GMY:=Lab.Vid.Height;
CSc:=1;CC:=1;CL:=1;CO:=1;CS:=1;
cx:=GMX div 2;
cy:=GMY div 2+1;
Blue:=RGB(255,0,0);
Red:=RGB(200,200,200);
Yelow:=RGB(0,255,0);
New(Scene,Create);
New(Scene^.Camera[CC],Create(0,0,0,0,0,0));
New(Light[CL],Create(-100,-100,0));
New(Scene^.Camera[CC]^.Obj[CO],Create(0,0,0,0,0,0));
Accept:=True;View:=False;
end;
procedure TLab.FormCreate(Sender: TObject);
var i,j:Word;
begin
Tables;
@InPut[1]:=@InPut1;
@InPut[2]:=@InPut2;
New(t);
For i:=0 to GMT do
New(t^[i]);
For i:=0 to GMT do
For j:=0 to GMT do
t^[i]^[j]:=RGB(255,0,0);
Data;
end;
procedure TLab.TimerTimer(Sender: TObject; LagCount: Integer);
var i:Word;
begin
if(Keys[VK_Escape])Then halt;
if(Bol=False)and(Keys[VK_F9])and(CountSide>0)Then begin
if(CountSide=0)Then begin
ShowMessage('Для просмотра нужна хотя бы одна грань');
exit;
end;
Bol:=True;View:=True;
Scene^.Camera[CC]^.Obj[CO]^.Done;
Scene^.Camera[CC]^.Done;
Scene^.Done;
CreateTMP(Scene^.Camera[CC]^.Obj[CO]);
For i:=1 to Scene^.Camera[CC]^.Obj[CO]^.Count do
Scene^.Camera[CC]^.Obj[CO]^.Side[i]^.o:=tmp_o;
Vid.Surface.Fill(0);
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end
else if(Bol)Then
if(Keys[ord('Y')])Then
begin
Rot:=YRot;
Vid.Surface.Fill(0);
Scene^.Camera[CC]^.Obj[CO]^.Rotate(CosA,SinA,Angle,Rot);
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end
else if(Keys[Ord('X')])Then
begin
Rot:=XRot;
Vid.Surface.Fill(0);
Scene^.Camera[CC]^.Obj[CO]^.Rotate(CosA,SinA,Angle,Rot);
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end
else if(Keys[Ord('Z')])Then
begin
Rot:=ZRot;
Vid.Surface.Fill(0);
Scene^.Camera[CC]^.Obj[CO]^.Rotate(CosA,SinA,Angle,Rot);
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end
else if(Keys[VK_Space])Then
begin
if(Space.Visible=False)Then begin
Space.Visible:=True;
Enter.Visible:=True;
BSide.Visible:=True;
BCube.Visible:=True;
Menu.Items[0].Visible:=True;
Menu.Items[1].Visible:=True;
Menu.Items[2].Visible:=True;
Width:=455;
Height:=465;
Left:=108;
Top:=-7;
Vid.Width:=385;
Vid.Height:=385;
Vid.Top:=32;
Vid.Left:=32;
GMX:=Lab.Vid.Width;
GMY:=Lab.Vid.Height;
GetMaxX:=GMX-1;
GetMaxY:=GMY-1;
end;
M:=0;N:=0;Bol:=False;
View:=False;
ShowSide;
Flip(Vid);
end;
end;
procedure TLab.VidMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var E:Boolean;
begin
E:=False;
if(View=False)Then InPut[Figure](x,y,E);
if(E=True)Then exit;
end;
procedure TLab.EnterClick(Sender: TObject);
var i:Word;
begin
if(CountSide=0)Then begin
ShowMessage('Для просмотра нужна хотя бы одна грань');
exit;
end;
Bol:=True;View:=True;
Scene^.Camera[CC]^.Obj[CO]^.Done;
Scene^.Camera[CC]^.Done;
Scene^.Done;
CreateTMP(Scene^.Camera[CC]^.Obj[CO]);
For i:=1 to Scene^.Camera[CC]^.Obj[CO]^.Count do
Scene^.Camera[CC]^.Obj[CO]^.Side[i]^.o:=tmp_o;
Vid.Surface.Fill(0);
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end;
procedure TLab.N3Click(Sender: TObject);
var i,j:integer;Name:String;
begin
OpenDialog.Execute;
Name:=OpenDialog.FileName;
Lab.Vid.Surface.Fill(0);
Data;
myform(GetMaxX,GetMaxY);
Flip(Lab.Vid);
if(Name='')Then exit;
LoadObject(Name,Scene^.Camera[CC]^.Obj[CO]);
LoadSide(Scene^.Camera[CC]^.Obj[CO]);
end;
procedure TLab.N4Click(Sender: TObject);
var Name:String;
begin
SaveDialog.Execute;
Name:=SaveDialog.FileName;
if(Name='')Then exit;
CreateTMP(Scene^.Camera[CC]^.Obj[CO]);
SaveObject(Name,Scene^.Camera[CC]^.Obj[CO]);
end;
procedure TLab.N2Click(Sender: TObject);
begin
Flip(Lab.Vid);
if(Lab.Width>Lab.Height)Then Lab.Height:=Lab.Width
else Lab.Width:=Lab.Height;
Vid.Height:=Lab.Height-81;
Vid.Width:=Lab.Width-81;
Lab.Vid.Surface.Fill(0);
Data;
myform(GetMaxX,GetMaxY);
Flip(Lab.Vid);
end;
procedure TLab.N9Click(Sender: TObject);
begin
ShowMessage('Autocad version 1.2 Copiright by Anton Sazonov');
end;
procedure TLab.N10Click(Sender: TObject);
begin
Halt;
end;
procedure TLab.SpaceClick(Sender: TObject);
var i:Word;
begin
M:=0;N:=0;Bol:=False;
View:=False;
ShowSide;
Flip(Vid);
end;
procedure TLab.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Keys[Key]:=True;
end;
procedure TLab.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Keys[Key]:=False;
end;
procedure TLab.CancelClick(Sender: TObject);
begin
Halt;
end;
procedure TLab.OKClick(Sender: TObject);
begin
Option[1]:=Box1.Text;
if(Option[1]='')Then begin
ShowMessage('Выберите режим!');
Exit;
end
else if(Option[1]='4 bits')Then PixMode:=1
else if(Option[1]='8 bits')Then PixMode:=2
else if(Option[1]='16 bits')Then PixMode:=3
else if(Option[1]='24 bits')Then PixMode:=4
else if(Option[1]='32 bits')Then PixMode:=5;
Option[2]:=Box6.Text;
if(Option[2]='')Then begin
ShowMessage('Выберите разрешение!');
Exit;
end
else if(Option[2]='640X480')Then begin
ScreenX:=640;ScreenY:=480;
end
else if(Option[2]='800X600')Then begin
ScreenX:=800;ScreenY:=600;
end
else if(Option[2]='1024X768')Then begin
ScreenX:=1024;ScreenY:=768;
end
else if(Option[2]='1280X1024')Then begin
ScreenX:=1280;ScreenY:=1024;
end;
Surf:=Vid.Surface;
SetGraphMode(PixMode);
Label1.Destroy;
Label6.Destroy;
Label7.Destroy;
Box1.Destroy;
Box6.Destroy;
Cancel.Destroy;
OK.Visible:=False;
Lab.Height:=465;
Lab.Top:=-7;
Menu.Items.Visible:=True;
Vid.Visible:=True;
Vid.Width:=385;
Vid.Height:=385;
Space.Visible:=True;
Enter.Visible:=True;
Lab.Vid.Surface.Fill(0);
myform(GetMaxX,GetMaxY);
Flip(Lab.Vid);
if(Lab.Width>Lab.Height)Then Lab.Height:=Lab.Width
else Lab.Width:=Lab.Height;
Vid.Height:=Lab.Height-81;
Vid.Width:=Lab.Width-81;
Lab.Vid.Surface.Fill(0);
Data;
myform(GetMaxX,GetMaxY);
Flip(Lab.Vid);
BCube.Visible:=True;
BSide.Visible:=True;
Menu.Items[0].Visible:=True;
Menu.Items[1].Visible:=True;
Menu.Items[2].Visible:=True;
OK.Destroy;
end;
procedure TLab.N8Click(Sender: TObject);
begin
Application.HelpContext(10);
end;
procedure TLab.BCubeClick(Sender: TObject);
begin
Figure:=2;
ClicCub[CS]:=True;
end;
procedure TLab.BSideClick(Sender: TObject);
begin
Figure:=1;
end;
procedure TLab.N6Click(Sender: TObject);
begin
if (View=True)Then begin
Space.Visible:=False;
Enter.Visible:=False;
BSide.Visible:=False;
BCube.Visible:=False;
Menu.Items[0].Visible:=False;
Menu.Items[1].Visible:=False;
Menu.Items[2].Visible:=False;
Width:=ScreenX+10;
Height:=ScreenY+20;
Left:=-10;
Top:=-30;
Vid.Width:=ScreenX+1;
Vid.Height:=ScreenY-16;
Vid.Top:=0;
Vid.Left:=0;
GMX:=ScreenX;GMY:=ScreenY;
GetMaxX:=GMX-1;GetMaxY:=GMY-1;
Scene^.Camera[CC]^.Obj[CO]^.Draw;
Flip(Vid);
end;
end;
end.
ЗАКЛЮЧЕНИЕ
Программирование с использованием трёхмерной графики - это способ описания языком программирования объёмных тел и отображения их на дисплее.
Измерение данной графики совпадает с измерением реальной системы, находящейся в пространстве, в котором ориентируется человек, и по этому любое материальное тело можно виртуально создать, задать ему условия и посмотреть на реакцию этого тела, задать телу правила поведения (траекторию движения) и узнать как оно будет себя вести, где будет находиться с течением времени.
Например, можно создать программу, создающую чертежи с использованием гостов и чертёжных обозначений. Она необходима конструкторам. Примером такой программы является автокод.
Можно видоизменить данную программу таким образом, чтобы она, виртуально создавала дом и сообщала какие нагрузки, он будет испытывать и не деформируется ли он при различных природных явлениях. Эта программа необходима архитекторам.
Ещё трёхмерную графику можно применить для создания механизмов, которые между собой взаимодействуют, показать какие силы при этом участвуют, и показать их взаимодействие с разных сторон. Такая программа нужна инженерам-механикам. Эти программы могут использовать как ортогональное (параллельное), так и центральное проецирование (проецирование с учётом перспективы).
Программа, создающая трёхмерную анимацию (фильм, мультфильм), так же может быть реализована на компьютере. Эта программа должна использовать только центральное проецирование (перспективное), и желательно наличие некоторых спецэффектов: прозрачности, освещённости, билинейной фильтрации текстур и т.д.
Трёхмерная графика необходима везде, где производятся материальные объекты, где есть инженеры, конструкторы, архитекторы, просто квалифицированные рабочие, а именно: в самолётостроении, в машиностроении, в судостроении, в строительстве, в космической промышленности и т. д.
С трёхмерной графикой, так или иначе, приходится сталкиваться дизайнерам одежды, дизайнерам интернет-сайтов, любым другим дизайнерам, работникам отделов рекламы, продюсерам и т. д.
Трёхмерной графикой пользовались всегда. До объёмного изображения на компьютере чертили чертежи на бумаге, до чертежей рисовали эскизы или рисунки, до рисунков пользовались заданием объектов аналитически на бумаге или в уме.
Если дать оценку трёхмерной графики в материальном производстве, то она будет следующей: трёхмерная графика, как способ изображения объёмных фигур или тел, является самым наглядным методом представления информации, используемой в материальном производстве. Без трёхмерной графики не было бы налажено любое материальное производство. Самый удобный способ задания и использования трёхмерной или объёмной графики осуществляется с помощью информационных технологий, а именно компьютера.
СПИСОК ЛИТЕРАТУРЫ
1 С. Бобровский «Delphi 5». 2007
2 О.Е. Акимов «Дискретная математика, логика, группы, графы».
3 М.П. Богдан «Конспект лекций» 2006
4 Фаронов В. В. «Turbo Pascal 7.0» 2005
5 В. Кулаков «Программирование на аппаратном уровне»
6 А.В. Потапкин, Д. Ф., Кучвальский «3D Studio Max» 2006
Страницы: 1, 2
