Files

130 lines
4.3 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit Octahedron;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
Geometry;
type
{ TForm1 }
TForm1 = class(TForm)
BackScreen: TImage;
StartStopBtn: TButton;
Screen: TPaintBox;
procedure StartStopBtnClick(Sender: TObject);
private
Model: array[1..10] of Object3D; { трехмерный объект }
public
end;
var
Form1: TForm1;
IsRunning: Boolean = false;
implementation
{$R *.lfm}
procedure ShowShape(Shape: Object3D); { нарисовать объект }
var
i, Xs, Ys: Integer;
x, y, z: Real;
const
N = 300; { "глубина" экрана }
begin
for i := 0 to High(Shape.edges) do { цикл по всем ребрам }
begin { координаты первой точки ребра }
x := Shape.vertices[Shape.edges[i].src].x + Shape.xc;
y := Shape.vertices[Shape.edges[i].src].y + Shape.yc;
z := Shape.vertices[Shape.edges[i].src].z + Shape.zc;
if Abs(z) < 0.01 then z := 0.01; { избегаем деления на нуль }
{ вычисляем экранные координаты }
Xs := Round(Form1.Screen.Width div 2 + N * x / z);
Ys := Round(Form1.Screen.Height div 2 + N * y / z);
Form1.BackScreen.Canvas.MoveTo(Xs, Ys);
{ координаты второй точки зрения }
x := Shape.vertices[Shape.edges[i].dest].x + Shape.xc;
y := Shape.vertices[Shape.edges[i].dest].y + Shape.yc;
z := Shape.vertices[Shape.edges[i].dest].z + Shape.zc;
if Abs(z) < 0.01 then z := 0.01; { избегаем деления на нуль }
{ и ее экранные координаты }
Xs := Round(Form1.Screen.Width div 2 + N * x / z);
Ys := Round(Form1.Screen.Height div 2 + N * y / z);
Form1.BackScreen.Canvas.LineTo(Xs, Ys); { рисуем ребро }
end;
end;
{ TForm1 }
procedure TForm1.StartStopBtnClick(Sender: TObject); { главная процедура }
var
oldtime: TDateTime;
pause: Integer;
center, velocity, axis: Vertex;
i: Integer;
const
MSecsPerFrame = 25; { скорость работы (кадров в секунду) }
begin
if IsRunning then
begin
IsRunning := false;
StartStopBtn.Caption := 'Пуск';
for i := 1 to Length(Model) do
FreeAndNil(Model[i]);
Exit;
end;
StartStopBtn.Caption := 'Стоп';
IsRunning := true;
for i := 1 to Length(Model) do
begin
axis.x := Random(10) / 100; { скорость вращения вокруг оси Ox }
axis.y := Random(10) / 100; { скорость вращения вокруг оси Oy }
axis.z := Random(10) / 100; { скорость вращения вокруг оси Oz }
velocity.x := 10 - Random(20); { и составляющие }
velocity.y := 15 - Random(30); { скорости }
velocity.z := 20 - Random(40);
center.x := (Screen.Width div 2) - Random(Screen.Width); { начальное положение }
center.y := (Screen.Width div 2) - Random(Screen.Width); { начальное положение }
center.z := Random(300) + 200;
Model[i] := Object3D.Create(center, velocity, axis) { загрузить объект }
end;
while IsRunning do
begin
oldtime := Now;
BackScreen.Canvas.FillRect(Rect(0, 0, Screen.Width, Screen.Height));
for i := 1 to Length(Model) do
begin
{ отразить от стена (3D-аналог "молекулы в закрытом сосуде") }
MoveShape(Model[i], BackScreen.Width div 2, BackScreen.Height div 2);
RotateShape(Model[i]); { поворот модели }
ShowShape(Model[i]); { очистить экран и нарисовать объект }
Model[i].MoveCenter()
end;
{ отобразить объект на основном экране }
Screen.Canvas.CopyRect(Rect(0, 0, Screen.Width, Screen.Height),
BackScreen.Canvas, Rect(0, 0, Screen.Width, Screen.Height));
Application.ProcessMessages;
pause := Round(MSecsPerFrame - (Now - oldtime) * MSecsPerDay);
if pause > 0 then Sleep(pause); { задержка }
if Application.Terminated then Exit;
end;
end;
end.