From 6d7c43c85f8852ed3b3fa9cefc742bc87e941842 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 17 Dec 2025 12:12:16 +0100 Subject: =?UTF-8?q?=D0=94=D0=BE=D0=B1=D0=B0=D0=B2=D0=B8=D0=BB=20=D1=82?= =?UTF-8?q?=D1=80=D0=B5=D1=82=D1=8C=D1=8E=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=83?= =?UTF-8?q?=20=D0=B7=D0=B0=D0=BD=D0=B8=D0=BC=D0=B0=D1=82=D0=B5=D0=BB=D1=8C?= =?UTF-8?q?=D0=BD=D0=BE=D0=B3=D0=BE=20=D0=BF=D1=80=D0=BE=D0=B3=D1=80=D0=B0?= =?UTF-8?q?=D0=BC=D0=BC=D0=B8=D1=80=D0=BE=D0=B2=D0=B0=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../3/2_projection/octahedron.pas" | 156 +++++++++++++++++++++ 1 file changed, 156 insertions(+) create mode 100644 "\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/3/2_projection/octahedron.pas" (limited to 'Занимательное программирование/3/2_projection/octahedron.pas') diff --git "a/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/3/2_projection/octahedron.pas" "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/3/2_projection/octahedron.pas" new file mode 100644 index 0000000..4059739 --- /dev/null +++ "b/\320\227\320\260\320\275\320\270\320\274\320\260\321\202\320\265\320\273\321\214\320\275\320\276\320\265 \320\277\321\200\320\276\320\263\321\200\320\260\320\274\320\274\320\270\321\200\320\276\320\262\320\260\320\275\320\270\320\265/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. + -- cgit v1.2.3