unit kub;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Label1: TLabel;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
T3DCoord=(X,Y,Z);
T3DPoint=ARRAY[X..Z] of Real;
TEdges=ARRAY of ARRAY [1..2] of Byte;
TPoints=ARRAY of T3DPoint;
TMatrix=ARRAY[1..4,1..4] of Real;
TAxis=(AxX,AxY,AxZ);
var
points: TPoints;
edges: TEdges;
X1:real=0;
Y1:real=240;
scal:real=1;
step:real=10;
step1:real=1;
angles:ARRAY[AxX..AxZ] of Real=(0.0,0.0,0.0) ;
Procedure kubb;
begin
SetLength(points, 8);
SetLength(edges, 12);
//координаты точек
points[0][X]:=0; points[0][Y]:=0; points[0][Z]:=0;
points[1][X]:=100; points[1][Y]:=0; points[1][Z]:=0;
points[2][X]:=150; points[2][Y]:=50; points[2][Z]:=100;
points[3][X]:=50; points[3][Y]:=50; points[3][Z]:=100;
points[4][X]:=0; points[4][Y]:=100; points[4][Z]:=0;
points[5][X]:=100; points[5][Y]:=100; points[5][Z]:=0;
points[6][X]:=150; points[6][Y]:=150; points[6][Z]:=100;
points[7][X]:=50; points[7][Y]:=150; points[7][Z]:=100;
// ребрa от точки в точку
edges[0][1]:=0; edges [0][2]:=1;
edges[1][1]:=0; edges [1][2]:=3;
edges[2][1]:=0; edges [2][2]:=4;
edges[3][1]:=2; edges [3][2]:=1;
edges[4][1]:=2; edges [4][2]:=6;
edges[5][1]:=2; edges [5][2]:=3;
edges[6][1]:=5; edges [6][2]:=1;
edges[7][1]:=5; edges [7][2]:=6;
edges[8][1]:=5; edges [8][2]:=4;
edges[9][1]:=7; edges [9][2]:=4;
edges[10][1]:=7; edges [10][2]:=3;
edges[11][1]:=7; edges [11][2]:=6;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
kubb;
end;
FUNCTION Rotate3D(p:T3DPoint; origin:T3DPoint; Axis:TAxis; alpha:REAL):T3DPoint;
FUNCTION Multiple(m:TMatrix;m2:T3DPoint):T3DPoint;
BEGIN
Result[X]:=m[1,1]*m2[X]+m[1,2]*m2[Y]+m[1,3]*m2[Z]+m[1,4];
Result[Y]:=m[2,1]*m2[X]+m[2,2]*m2[Y]+m[2,3]*m2[Z]+m[2,4];
Result[Z]:=m[3,1]*m2[X]+m[3,2]*m2[Y]+m[3,3]*m2[Z]+m[3,4]
END;
// Поворот точки p вокруг точки origin вокруг оси Axis на угол alpha
VAR matrix:TMatrix;
BEGIN
CASE Axis OF
AxX: BEGIN
matrix[1,1]:=1;
matrix[1,2]:=0;
matrix[1,3]:=0;
matrix[1,4]:=0;
matrix[2,1]:=0;
matrix[2,2]:=COS(alpha);
matrix[2,3]:=SIN(alpha);
matrix[2,4]:=0;
matrix[3,1]:=0;
matrix[3,2]:=-SIN(alpha);
matrix[3,3]:=COS(alpha);
matrix[3,4]:=0;
matrix[4,1]:=0;
matrix[4,2]:=0;
matrix[4,3]:=0;
matrix[4,4]:=1
END;
AxY: BEGIN
matrix[1,1]:=COS(alpha);
matrix[1,2]:=0;
matrix[1,3]:=-SIN(alpha);
matrix[1,4]:=0;
matrix[2,1]:=0;
matrix[2,2]:=1;
matrix[2,3]:=0;
matrix[2,4]:=0;
matrix[3,1]:=SIN(alpha);
matrix[3,2]:=0;
matrix[3,3]:=COS(alpha);
matrix[3,4]:=0;
matrix[4,1]:=0;
matrix[4,2]:=0;
matrix[4,3]:=0;
matrix[4,4]:=1
END;
AxZ: BEGIN
matrix[1,1]:=COS(alpha);
matrix[1,2]:=SIN(alpha);
matrix[1,3]:=0;
matrix[1,4]:=0;
matrix[2,1]:=-SIN(alpha);
matrix[2,2]:=COS(alpha);
matrix[2,3]:=0;
matrix[2,4]:=0;
matrix[3,1]:=0;
matrix[3,2]:=0;
matrix[3,3]:=1;
matrix[3,4]:=0;
matrix[4,1]:=0;
matrix[4,2]:=0;
matrix[4,3]:=0;
matrix[4,4]:=1
END;
END;
Result:=Multiple(matrix,p);
END;
Procedure Draw ;
var
i: byte;
j:TAxis;
begin
with Form1.Image1.Canvas do
begin
Brush.Color:=clWhite;
FillRect (Form1.Image1.Canvas.ClipRect);
Pen.Color:=clBlue;
for i:=0 to Length(edges)-1 do
FOR j:= AxX to AxZ DO
points[i]:=Rotate3D( points[i],j, angles[j]);
begin
MoveTo (TRUNC(points[edges[i,1],X]*scal+X1),
TRUNC(points[edges[i,1],Y]*scal+Y1));
LineTo (TRUNC(points[edges[i,2],X]*scal+X1),
TRUNC(points[edges[i,2],Y]*scal+Y1));
end;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
//Draw;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
X1:=X1+step;
Draw;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
X1:=X1-step;
Draw;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Y1:=Y1-step;
Draw;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Y1:=Y1+step;
Draw;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
scal:= scal+step1;
Draw;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
scal:= scal-step1;
Draw;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
angles[AxX]:=angles[AxX]+1;
end;
end.