Код:
unit Unit1;
interface
uses Windows, Classes, Graphics, Forms, Buttons, Controls, ExtCtrls,
StdCtrls;
type
TForm1 = class(TForm)
Timer: TTimer;
PaintBox: TPaintBox;
Panel1: TPanel;
sbtRotateYZf: TSpeedButton;
sbtRotateYZt: TSpeedButton;
sbtRotateXZf: TSpeedButton;
sbtRotateXZt: TSpeedButton;
sbtRotateXYf: TSpeedButton;
sbtRotateXYt: TSpeedButton;
Button1: TButton;
procedure PaintBox_onPaint(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure sbtRotate_onMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure sbtRotate_onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Form_onCreate(Sender: TObject);
procedure Form_onResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FFillColor : TColor;
public
end;
var
Form1: TForm1;
RotateXYt,RotateXYf,RotateXZt,RotateXZf,RotateYZt,RotateYZf:boolean;
implementation
{$R *.DFM}
const
mOkt=6;
Type
TMain = record
X, Y, Z : double;
Sd : array[1..3] of byte;
Xe, Ye : Integer;
end;
TOkt = array[1..mOkt] of TMain;
const
R=15;
A=r*0.8660254;
H=r*0.5;
Okt : TOkt = (
{1} (X : -R; Y: 0; Z: 0; Sd:(6,2,4)),
{2} (X : 0; Y: 0; Z: -R; Sd:(6,3,5)),
{3} (X : R; Y: 0; Z: 0; Sd:(6,4,5)),
{4} (X : 0; Y: 0; Z: R; Sd:(6,5,0)),
{5} (X : 0; Y: -R; Z: 0; Sd:(1,0,0)),
{6} (X : 0; Y: R; Z: 0; Sd:(0,0,0))
);
Var
dxy,dxz,dyz : double; // Угол поворота по осям
Fok : integer = 800; // Фокусное расстояние
procedure XYZ(X,Y,Z : double; Var X2,Y2 : integer);
begin
X2:=Round(X*Fok/100+(Form1.PaintBox.Width div 2));
Y2:=Round(Y*Fok/100+(Form1.PaintBox.Height div 2));
end;
procedure Pw(var X,Y : double; Al : double);
var
X2, Y2 : double;
sina, cosa : double;
begin
if Al=0 then Exit;
sina :=sin(Al); cosa:=cos(Al);
X2:=(X*Cosa-Y*Sina);
Y2:=(X*Sina+Y*Cosa);
X:=X2; Y:=Y2;
end;
procedure TForm1.PaintBox_onPaint(Sender: TObject);
var i,j,c : integer;
qOkt:TOkt;
begin
qOkt:=Okt;
for i:=1 to mOkt do begin
Pw(qOkt[i].X, qOkt[i].Y, dxy);
Pw(qOkt[i].X, qOkt[i].Z, dxz);
Pw(qOkt[i].Y, qOkt[i].Z, dyz);
XYZ(qOkt[i].X, qOkt[i].Y, qOkt[i].Z, qOkt[i].Xe, qOkt[i].Ye);
end;
for i:=1 to mOkt do
for j:=1 to 3 do
if qOkt[i].Sd[J]<>0 then begin
c:=qOkt[i].Sd[j];
with PaintBox.Canvas do begin
MoveTo(qOkt[i].Xe, qOkt[i].Ye);
LineTo(qOkt[c].Xe, qOkt[c].Ye);
end;
end;
end;
procedure TForm1.TimerTimer(Sender: TObject);
const N:real=0.03;
begin
if RotateXYt then dxy:=dxy+N;
if RotateXZt then dxz:=dxz+N;
if RotateYZt then dyz:=dyz+N;
if RotateXYf then dxy:=dxy-N;
if RotateXZf then dxz:=dxz-N;
if RotateYZf then dyz:=dyz-N;
if (RotateXYt or RotateXYf or RotateXZt or RotateXZf or RotateYZt or RotateYZf) then PaintBox.Repaint;
end;
procedure TForm1.sbtRotate_onMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Sender=sbtRotateXYt then RotateXYt:=true;
if Sender=sbtRotateXYf then RotateXYf:=true;
if Sender=sbtRotateXZt then RotateXZt:=true;
if Sender=sbtRotateXZf then RotateXZf:=true;
if Sender=sbtRotateYZt then RotateYZt:=true;
if Sender=sbtRotateYZf then RotateYZf:=true;
end;
procedure TForm1.sbtRotate_onMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Sender=sbtRotateXYt then RotateXYt:=false;
if Sender=sbtRotateXYf then RotateXYf:=false;
if Sender=sbtRotateXZt then RotateXZt:=false;
if Sender=sbtRotateXZf then RotateXZf:=false;
if Sender=sbtRotateYZt then RotateYZt:=false;
if Sender=sbtRotateYZf then RotateYZf:=false;
end;
procedure TForm1.Form_onCreate(Sender: TObject);
begin
dxy:=0.3; dyz:=0.3; dxz:=0.3;
RotateXYt:=false;
RotateXYf:=false;
RotateXZt:=false;
RotateXZf:=false;
RotateYZt:=false;
RotateYZf:=false;
end;
procedure TForm1.Form_onResize(Sender: TObject);
begin
Fok:=Round((Width+Height)*0.8);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
end.