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
public
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
;
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
;
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
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
.