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

This commit is contained in:
2025-12-17 12:12:16 +01:00
parent 2878f1e34c
commit 6d7c43c85f
34 changed files with 4191 additions and 0 deletions

View File

@@ -0,0 +1,302 @@
unit Geometry;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils;
type
{ Вершины }
Vertex = record
x, y, z: Real; { Координаты вершины }
end;
{ Ребра }
Edge = record
src, dest: Integer; { Индексы соединяемых вершин }
end;
Object3D = record
vertices: array of Vertex; { вершины }
edges: array of Edge; { ребра }
xc, yc, zc: Real; { координаты центра объекта }
end;
Matrix = array[1..4, 1..4] of Real; { матрица 4x4 }
Column = array[1..4] of Real; { столбец }
function LoadObject3D(filename: String): Object3D;
function CopyObject3D(Shape: Object3D): Object3D;
{ умножение матрицы на матрицу }
function MMMult(lhs, rhs: Matrix): Matrix;
{ умножение матрицы на столбец }
function MCMult(lhs: Matrix; rhs: Column): Column;
{ матрица поворота модели }
function RotateMatrix(xa, ya, za: Real): Matrix;
function MoveMatrix(tx, ty, tz: Real): Matrix;
function ResizeMatrix(sx, sy, sz: Real): Matrix;
procedure RotateShape(var Shape: Object3D; xa, ya, za: Real);
procedure MoveShape(var Shape: Object3D; tx, ty, tz: Real);
procedure ResizeShape(var Shape: Object3D; sx, sy, sz: Real);
implementation
function LoadObject3D(filename: String): Object3D;
var
F: TextFile; { исходный файл }
NV, NE: Integer; { количество вершин, количество ребер }
Shape: Object3D; { модель }
i: Integer; { счетчик цикла }
begin
AssignFile(F, filename); { открываем исходный файл }
FileMode := 0; { в режиме "только чтение" }
Reset(F);
ReadLn(F, NV); { считываем количество вершин }
SetLength(Shape.vertices, NV); { и корректируем размер массива }
for i := 0 to NV - 1 do { считываем каждую вершину }
ReadLn(F, Shape.vertices[i].x, Shape.vertices[i].y, Shape.vertices[i].z);
ReadLn(F, NE); { то же для ребер }
SetLength(Shape.edges, NE);
for i := 0 to NE - 1 do
ReadLn(F, Shape.edges[i].src, Shape.edges[i].dest);
CloseFile(F);
LoadObject3D := Shape;
end;
function CopyObject3D(Shape: Object3D): Object3D;
begin
CopyObject3D.vertices := Copy(Shape.vertices, 0);
CopyObject3D.edges := Copy(Shape.edges, 0);
CopyObject3D.xc := Shape.xc;
CopyObject3D.yc := Shape.yc;
CopyObject3D.zc := Shape.zc
end;
function MMMult(lhs, rhs: Matrix): Matrix;
var
i, j, k: Integer;
r: Matrix;
s: Real;
begin
for i := 1 to 4 do
for j := 1 to 4 do
begin
s := 0;
for k := 1 to 4 do
s := s + lhs[i, k] * rhs[k, j];
r[i, j] := s;
end;
MMMult := r;
end;
function MCMult(lhs: Matrix; rhs: Column): Column;
var
k, i: Integer;
s: Real;
r: Column;
begin
for i := 1 to 4 do { аналогично MMMult }
begin
s := 0;
for k := 1 to 4 do
s := s + lhs[i, k] * rhs[k];
r[i] := s;
end;
MCMult := r;
end;
function RotateMatrix(xa, ya, za: Real): Matrix;
var
xr, yr, zr: Matrix;
begin
{ матрица поворота вокруг оси Ox }
xr[1, 1] := 1;
xr[1, 2] := 0;
xr[1, 3] := 0;
xr[1, 4] := 0;
xr[2, 1] := 0;
xr[2, 2] := Cos(xa);
xr[2, 3] := -Sin(xa);
xr[2, 4] := 0;
xr[3, 1] := 0;
xr[3, 2] := Sin(xa);
xr[3, 3] := Cos(xa);
xr[3, 4] := 0;
xr[4, 1] := 0;
xr[4, 2] := 0;
xr[4, 3] := 0;
xr[4, 4] := 1;
{ матрица поворота вокруг оси Oy }
yr[1, 1] := Cos(ya);
yr[1, 2] := 0;
yr[1, 3] := Sin(ya);
yr[1, 4] := 0;
yr[2, 1] := 0;
yr[2, 2] := 1;
yr[2, 3] := 0;
yr[2, 4] := 0;
yr[3, 1] := -Sin(ya);
yr[3, 2] := 0;
yr[3, 3] := Cos(ya);
yr[3, 4] := 0;
yr[4, 1] := 0;
yr[4, 2] := 0;
yr[4, 3] := 0;
yr[4, 4] := 1;
{ матрица поворота вокруг оси Oz }
zr[1, 1] := Cos(za);
zr[1, 2] := -Sin(za);
zr[1, 3] := 0;
zr[1, 4] := 0;
zr[2, 1] := Sin(za);
zr[2, 2] := Cos(za);
zr[2, 3] := 0;
zr[2, 4] := 0;
zr[3, 1] := 0;
zr[3, 2] := 0;
zr[3, 3] := 1;
zr[3, 4] := 0;
zr[4, 1] := 0;
zr[4, 2] := 0;
zr[4, 3] := 0;
zr[4, 4] := 1;
RotateMatrix := MMMult(MMMult(xr, yr), zr)
end;
function MoveMatrix(tx, ty, tz: Real): Matrix;
begin
MoveMatrix[1, 1] := 1;
MoveMatrix[1, 2] := 0;
MoveMatrix[1, 3] := 0;
MoveMatrix[1, 4] := tx;
MoveMatrix[2, 1] := 0;
MoveMatrix[2, 2] := 1;
MoveMatrix[2, 3] := 0;
MoveMatrix[2, 4] := ty;
MoveMatrix[3, 1] := 0;
MoveMatrix[3, 2] := 0;
MoveMatrix[3, 3] := 1;
MoveMatrix[3, 4] := tz;
MoveMatrix[4, 1] := 0;
MoveMatrix[4, 2] := 0;
MoveMatrix[4, 3] := 0;
MoveMatrix[4, 4] := 1
end;
function ResizeMatrix(sx, sy, sz: Real): Matrix;
begin
ResizeMatrix[1, 1] := sx;
ResizeMatrix[1, 2] := 0;
ResizeMatrix[1, 3] := 0;
ResizeMatrix[1, 4] := 0;
ResizeMatrix[2, 1] := 0;
ResizeMatrix[2, 2] := sy;
ResizeMatrix[2, 3] := 0;
ResizeMatrix[2, 4] := 0;
ResizeMatrix[3, 1] := 0;
ResizeMatrix[3, 2] := 0;
ResizeMatrix[3, 3] := sz;
ResizeMatrix[3, 4] := 0;
ResizeMatrix[4, 1] := 0;
ResizeMatrix[4, 2] := 0;
ResizeMatrix[4, 3] := 0;
ResizeMatrix[4, 4] := 1
end;
procedure RotateShape(var Shape: Object3D; xa, ya, za: Real);
var
rm: Matrix;
i: Integer;
c: Column;
begin
rm := RotateMatrix(xa, ya, za); { сгенерировать матрицу вращения }
c[4] := 1; { последний элемент столбца всегда равен единице }
for i := 0 to High(Shape.vertices) do { цикл по всем вершинам }
begin { High(a) возвращает верхний индекс массива a }
c[1] := Shape.vertices[i].x; { инициализация столбца }
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(rm, c); { вызов преобразования }
Shape.vertices[i].x := c[1]; { внесение изменений в модель }
Shape.vertices[i].y := c[2]; { в соответствии с полученным }
Shape.vertices[i].z := c[3] { результатом преобразования }
end
end;
procedure MoveShape(var Shape: Object3D; tx, ty, tz: Real);
var
mm: Matrix;
i: Integer;
c: Column;
begin
mm := MoveMatrix(tx, ty, tz);
c[4] := 1;
for i := 0 to High(Shape.vertices) do
begin
c[1] := Shape.vertices[i].x;
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(mm, c);
Shape.vertices[i].x := c[1];
Shape.vertices[i].y := c[2];
Shape.vertices[i].z := c[3]
end
end;
procedure ResizeShape(var Shape: Object3D; sx, sy, sz: Real);
var
mm: Matrix;
i: Integer;
c: Column;
begin
mm := ResizeMatrix(sx, sy, sz);
c[4] := 1;
for i := 0 to High(Shape.vertices) do
begin
c[1] := Shape.vertices[i].x;
c[2] := Shape.vertices[i].y;
c[3] := Shape.vertices[i].z;
c := MCMult(mm, c);
Shape.vertices[i].x := c[1];
Shape.vertices[i].y := c[2];
Shape.vertices[i].z := c[3]
end
end;
end.

View File

@@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="graphics_3d"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="graphics_3d.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="octahedron.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Octahedron"/>
</Unit>
<Unit>
<Filename Value="geometry.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Geometry"/>
</Unit>
<Unit>
<Filename Value="octahedron.txt"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="graphics_3d"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

View File

@@ -0,0 +1,28 @@
program graphics_3d;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Octahedron, geometry
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
{$PUSH}{$WARN 5044 OFF}
Application.MainFormOnTaskbar:=True;
{$POP}
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@@ -0,0 +1,175 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="graphics_3d.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="5"/>
<UsageCount Value="40"/>
</Unit>
<Unit>
<Filename Value="octahedron.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Octahedron"/>
<IsVisibleTab Value="True"/>
<TopLine Value="39"/>
<CursorPos X="45" Y="55"/>
<UsageCount Value="40"/>
<Bookmarks Count="1">
<Item0 X="17" Y="46" Left="1" Top="78" ID="3"/>
</Bookmarks>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="geometry.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Geometry"/>
<EditorIndex Value="2"/>
<TopLine Value="235"/>
<CursorPos X="10" Y="150"/>
<UsageCount Value="40"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="octahedron.txt"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="1"/>
<CursorPos X="4" Y="20"/>
<UsageCount Value="40"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Text"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="28">
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="68" Column="39" TopLine="67"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="40" Column="37" TopLine="31"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="139" Column="11" TopLine="128"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="187" TopLine="175"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="172" Column="9" TopLine="164"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="211" Column="17" TopLine="199"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="171" Column="45" TopLine="160"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="257" Column="18" TopLine="247"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="134" Column="7" TopLine="126"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="137" Column="14" TopLine="126"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="146" Column="23" TopLine="130"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="70" Column="19" TopLine="60"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="93" Column="12" TopLine="77"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="137" Column="14" TopLine="121"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="27" Column="45" TopLine="11"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="266" TopLine="248"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="31" Column="11" TopLine="19"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="73" Column="23" TopLine="58"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="77" Column="27" TopLine="63"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="143" Column="37" TopLine="132"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="146" Column="37" TopLine="136"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="18" Column="23" TopLine="18"/>
</Position>
<Position>
<Filename Value="geometry.pas"/>
<Caret Line="106" Column="23" TopLine="96"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="19" Column="23" TopLine="18"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="20" Column="23" TopLine="7"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="19" Column="23" TopLine="7"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="143" Column="10" TopLine="128"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="63" Column="37" TopLine="39"/>
</Position>
<Position>
<Filename Value="octahedron.pas"/>
<Caret Line="61" Column="18" TopLine="40"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@@ -0,0 +1,75 @@
object Form1: TForm1
Left = 352
Height = 673
Top = 32
Width = 600
Caption = 'Form1'
ClientHeight = 673
ClientWidth = 600
DesignTimePPI = 120
object BackScreen: TImage
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StartStopBtn
Left = 0
Height = 600
Top = 0
Width = 600
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 15
end
object Screen: TPaintBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = StartStopBtn
Left = 0
Height = 600
Top = 0
Width = 600
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 15
end
object StartStopBtn: TButton
AnchorSideLeft.Control = Owner
AnchorSideLeft.Side = asrCenter
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 472
Height = 48
Top = 615
Width = 118
Anchors = [akRight, akBottom]
BorderSpacing.Right = 10
BorderSpacing.Bottom = 10
Caption = 'Пуск'
TabOrder = 0
OnClick = StartStopBtnClick
end
object ResizeField: TFloatSpinEdit
AnchorSideLeft.Control = Owner
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 10
Height = 28
Top = 635
Width = 63
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 10
BorderSpacing.Bottom = 10
TabOrder = 1
Value = 1
end
object Label1: TLabel
Left = 10
Height = 20
Top = 615
Width = 125
Caption = 'Изменить размер'
end
end

View File

@@ -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.

View File

@@ -0,0 +1,20 @@
6
-100 -100 0
-100 100 0
100 100 0
100 -100 0
0 0 -141.42
0 0 141.42
12
0 1
1 2
2 3
3 0
4 0
4 1
4 2
4 3
5 0
5 1
5 2
5 3