Добавил третью главу занимательного программирования

Занимательное программирование/3/2_projection/octahedron.pas

@@ -0,0 +1,156 @@
+unit Octahedron;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  Spin, Geometry;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    BackScreen: TImage;
+    Label1: TLabel;
+    ResizeField: TFloatSpinEdit;
+    StartStopBtn: TButton;
+    Screen: TPaintBox;
+    procedure StartStopBtnClick(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+  IsRunning: Boolean = false;
+
+implementation
+
+{$R *.lfm}
+
+procedure ShowShape(Shape: Object3D); { нарисовать объект }
+var
+  i, Xs, Ys: Integer;
+  x, y: Real;
+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;
+                                     { вычисляем экранные координаты }
+    Xs := Round(Form1.Screen.Width div 2 + x);
+    Ys := Round(Form1.Screen.Height div 2 + y);
+
+    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;
+
+    Xs := Round(Form1.Screen.Width div 2 + x);
+    Ys := Round(Form1.Screen.Height div 2 + y);
+
+    Form1.BackScreen.Canvas.LineTo(Xs, Ys); { рисуем ребро }
+  end;
+end;
+
+{ TForm1 }
+
+procedure TForm1.StartStopBtnClick(Sender: TObject); { главная процедура }
+var
+  oldtime: TDateTime;
+  Model, BackModel: Object3D; { трехмерный объект }
+  Vx, Vy, Vz: Real; { значения составляющих его скорости }
+  pause: Integer;
+const
+  MSecsPerFrame = 25; { скорость работы (кадров в секунду) }
+  xa = 0.01; { скорость вращения вокруг оси Ox }
+  ya = 0.05; { скорость вращения вокруг оси Oy }
+  za = 0.08; { скорость вращения вокруг оси Oz }
+begin
+  if IsRunning then
+  begin
+    IsRunning := false;
+    StartStopBtn.Caption := 'Пуск';
+    Exit;
+  end;
+  StartStopBtn.Caption := 'Стоп';
+  IsRunning := true;
+
+  Model := LoadObject3D('octahedron.txt'); { загрузить объект }
+  ResizeShape(Model, ResizeField.Value, ResizeField.Value, ResizeField.Value);
+
+  Model.xc := 0; { начальное положение }
+  Model.yc := 0; { объекта }
+  Model.zc := 200;
+  Vx := 10; { и составляющие }
+  Vy := 15; { скорости }
+  Vz := 20;
+
+  while IsRunning do
+  begin
+    oldtime := Now;
+
+    { отразить от стена (3D-аналог "молекулы в закрытом сосуде") }
+    if Model.xc > BackScreen.Width div 2 then
+    begin
+      Model.xc := BackScreen.Width div 2;
+      Vx := -Vx;
+    end;
+    if Model.xc < -BackScreen.Width div 2 then
+    begin
+      Model.xc := -BackScreen.Width div 2;
+      Vx := -Vx;
+    end;
+
+    if Model.yc > BackScreen.Height div 2 then
+    begin
+      Model.yc := BackScreen.Height div 2;
+      Vy := -Vy;
+    end;
+    if Model.yc < -BackScreen.Height div 2 then
+    begin
+      Model.yc := -BackScreen.Height div 2;
+      Vy := -Vy;
+    end;
+
+    if Model.zc > 1000 then
+    begin
+      Model.zc := 1000;
+      Vz := -Vz;
+    end;
+    if Model.zc < 200 then
+    begin
+      Model.zc := 200;
+      Vz := -Vz;
+    end;
+
+    RotateShape(Model, xa, ya, za); { поворот модели }
+    BackModel := CopyObject3D(Model);
+    MoveShape(Model, Vx, Vy, Vz); { переместить объект }
+
+    BackScreen.Canvas.FillRect(Rect(0, 0, Screen.Width, Screen.Height));
+    ShowShape(Model); { очистить экран и нарисовать объект }
+                      { отобразить объект на основном экране }
+    Screen.Canvas.CopyRect(Rect(0, 0, Screen.Width, Screen.Height),
+        BackScreen.Canvas, Rect(0, 0, Screen.Width, Screen.Height));
+
+    Model := CopyObject3D(BackModel);
+    Model.xc := Model.xc + Vx;
+    Model.yc := Model.yc + Vy;
+    Model.zc := Model.zc + Vz;
+
+    Application.ProcessMessages;
+    pause := Round(MSecsPerFrame - (Now - oldtime) * MSecsPerDay);
+    if pause > 0 then Sleep(pause); { задержка }
+
+    if Application.Terminated then Exit;
+  end;
+end;
+
+end.
+