diff options
| author | Eugen Wissner <belka@caraus.de> | 2025-12-13 16:35:46 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2025-12-13 16:35:46 +0100 |
| commit | c1147629f7aae2ee90ccd7c9f1ccbf106361d486 (patch) | |
| tree | 67a549c6796702fa3db9248d599424066345dab4 /Занимательное программирование/1/5_falling_ball | |
| parent | 98329e0a3dd4f78b5d815ac3896272ec70904901 (diff) | |
| download | book-exercises-c1147629f7aae2ee90ccd7c9f1ccbf106361d486.tar.gz | |
Add book "Занимательное программирование"
Diffstat (limited to 'Занимательное программирование/1/5_falling_ball')
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/falling_ball.ico | bin | 0 -> 137040 bytes | |||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/falling_ball.lpi | 78 | ||||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/falling_ball.lpr | 22 | ||||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/falling_ball.lps | 81 | ||||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/falling_ball.res | bin | 0 -> 139052 bytes | |||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/unit1.lfm | 27 | ||||
| -rw-r--r-- | Занимательное программирование/1/5_falling_ball/unit1.pas | 141 |
7 files changed, 349 insertions, 0 deletions
diff --git a/Занимательное программирование/1/5_falling_ball/falling_ball.ico b/Занимательное программирование/1/5_falling_ball/falling_ball.ico Binary files differnew file mode 100644 index 0000000..0341321 --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/falling_ball.ico diff --git a/Занимательное программирование/1/5_falling_ball/falling_ball.lpi b/Занимательное программирование/1/5_falling_ball/falling_ball.lpi new file mode 100644 index 0000000..6ff0da5 --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/falling_ball.lpi @@ -0,0 +1,78 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="11"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="falling_ball"/> + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="falling_ball.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="falling_ball"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/Занимательное программирование/1/5_falling_ball/falling_ball.lpr b/Занимательное программирование/1/5_falling_ball/falling_ball.lpr new file mode 100644 index 0000000..135237c --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/falling_ball.lpr @@ -0,0 +1,22 @@ +program falling_ball; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/Занимательное программирование/1/5_falling_ball/falling_ball.lps b/Занимательное программирование/1/5_falling_ball/falling_ball.lps new file mode 100644 index 0000000..2cefe81 --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/falling_ball.lps @@ -0,0 +1,81 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="11"/> + <BuildModes Active="Default"/> + <Units Count="2"> + <Unit0> + <Filename Value="falling_ball.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="26"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + <IsVisibleTab Value="True"/> + <TopLine Value="81"/> + <CursorPos X="3" Y="107"/> + <UsageCount Value="26"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit1> + </Units> + <JumpHistory Count="11" HistoryIndex="10"> + <Position1> + <Filename Value="unit1.pas"/> + </Position1> + <Position2> + <Filename Value="unit1.pas"/> + <Caret Line="46" Column="10"/> + </Position2> + <Position3> + <Filename Value="unit1.pas"/> + <Caret Line="64" Column="19" TopLine="13"/> + </Position3> + <Position4> + <Filename Value="unit1.pas"/> + <Caret Line="91" Column="13" TopLine="37"/> + </Position4> + <Position5> + <Filename Value="unit1.pas"/> + <Caret Line="89" Column="23" TopLine="46"/> + </Position5> + <Position6> + <Filename Value="unit1.pas"/> + <Caret Line="21" Column="9"/> + </Position6> + <Position7> + <Filename Value="unit1.pas"/> + <Caret Line="104" Column="28" TopLine="53"/> + </Position7> + <Position8> + <Filename Value="unit1.pas"/> + <Caret Line="105" Column="38" TopLine="52"/> + </Position8> + <Position9> + <Filename Value="unit1.pas"/> + <Caret Line="104" Column="38" TopLine="53"/> + </Position9> + <Position10> + <Filename Value="unit1.pas"/> + <Caret Line="102" Column="39" TopLine="72"/> + </Position10> + <Position11> + <Filename Value="unit1.pas"/> + <Caret Line="123" Column="70" TopLine="79"/> + </Position11> + </JumpHistory> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0" ActiveMode=""/> + </RunParams> + </ProjectSession> +</CONFIG> diff --git a/Занимательное программирование/1/5_falling_ball/falling_ball.res b/Занимательное программирование/1/5_falling_ball/falling_ball.res Binary files differnew file mode 100644 index 0000000..1adb040 --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/falling_ball.res diff --git a/Занимательное программирование/1/5_falling_ball/unit1.lfm b/Занимательное программирование/1/5_falling_ball/unit1.lfm new file mode 100644 index 0000000..19da978 --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/unit1.lfm @@ -0,0 +1,27 @@ +object Form1: TForm1 + Left = 227 + Height = 575 + Top = 577 + Width = 986 + Caption = 'Form1' + ClientHeight = 575 + ClientWidth = 986 + DesignTimePPI = 93 + LCLVersion = '2.0.12.0' + object Screen: TPaintBox + Left = 8 + Height = 474 + Top = 9 + Width = 968 + OnPaint = ScreenPaint + end + object StartStopBtn: TButton + Left = 440 + Height = 31 + Top = 509 + Width = 112 + Caption = 'Пуск' + OnClick = StartStopBtnClick + TabOrder = 0 + end +end diff --git a/Занимательное программирование/1/5_falling_ball/unit1.pas b/Занимательное программирование/1/5_falling_ball/unit1.pas new file mode 100644 index 0000000..7216a5d --- /dev/null +++ b/Занимательное программирование/1/5_falling_ball/unit1.pas @@ -0,0 +1,141 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + StartStopBtn: TButton; + Screen: TPaintBox; + procedure ScreenPaint(Sender: TObject); + procedure StartStopBtnClick(Sender: TObject); + private + const R: Integer = 10; { Радиус шара } + Vx0: Integer = 3; { Горизонтальная скорость шара } + a: Real = 1; { Ускорение } + K: Real = 0.8; { Коэффицент потери } + + var X, Y: Integer; { Координаты шара } + + public + + end; + +var + Form1: TForm1; + IsRunning: Boolean = false; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.StartStopBtnClick(Sender: TObject); + var Vx, Vy: Real; { Состовляющие скорости } +begin + if IsRunning then + begin + IsRunning := false; + StartStopBtn.Caption := 'Пуск'; + Exit; + end; + + StartStopBtn.Caption := 'Стоп'; + IsRunning := true; + + Vy := 0; { Вертикальная состовляющая скорости изначально равна нулю } + Vx := Vx0; + X := R + 5; { Начальное } + Y := Screen.Height div 2; { положение шара } + + Screen.Invalidate; + Application.ProcessMessages; + + Sleep(500); { Пауза, чтобы увидеть начальное положение на экране } + + while IsRunning do { Основной цикл } + begin + { Screen.Canvas.Pen.Color := ClBtnFace; + Screen.Canvas.Ellipse(X - R, Y - R, X + R, Y + R); } + + X := X + Round(Vx); { Сдвигаем на новую позицию } + Y := Y + Round(Vy); + + if X > Screen.Width - R then { Если шар вышел за экран, "нажимаем" } + Form1.StartStopBtnClick(nil); { кнопку StartStopBtn (1) } + if Y > Screen.Height - R then { Если шар стокнулся с землей } + begin + { "Отражаем" - как в предыдущих моделях но скорость уменьшается + в K раз если скорость стала по модулю (2) меньше единицы , + "нажимаем" StartStopBtn } + Y := Screen.Height - R; + Vy := -Vy * K; + if abs(Vy) < 1 then Form1.StartStopBtnClick(nil); + end; + + Vy := Vy + a; { Изменяем скорость в соответствии с ускорением } + + Screen.Invalidate; + + Sleep(3); + Application.ProcessMessages; + end; +end; + +procedure TForm1.ScreenPaint(Sender: TObject); + var T, U: Integer; + Vt, Vu: Real; +begin + if not IsRunning then Exit; + + Vu := 0; { Вертикальная состовляющая скорости изначально равна нулю } + Vt := Vx0; + T := R + 5; { Начальное } + U := Screen.Height div 2; { положение шара } + + Screen.Canvas.Pen.Color := clBlack; { Рисуем "подставку" } + Screen.Canvas.MoveTo(R + 5, Screen.Height div 2 + R); { на которой } + Screen.Canvas.LineTo(R + 5, Screen.Height); { лежит шар } + + Screen.Canvas.Brush.Color := clBlue; + Screen.Canvas.Brush.Style := bsSolid; + Screen.Canvas.Pen.Color := clBlue; + Screen.Canvas.Ellipse(T - R, U - R, T + R, U + R); { рисуем шар } + + while (T < X) or (U < Y) do + begin + T := T + Round(Vt); { Сдвигаем на новую позицию } + U := U + Round(Vu); + + if T > Screen.Width - R then { Если шар вышел за экран, "нажимаем" } + Form1.StartStopBtnClick(nil); { кнопку StartStopBtn (1) } + if U > Screen.Height - R then { Если шар стокнулся с землей } + begin + { "Отражаем" - как в предыдущих моделях но скорость уменьшается + в K раз если скорость стала по модулю (2) меньше единицы , + "нажимаем" StartStopBtn } + U := Screen.Height - R; + Vu := -Vu * K; + if abs(Vu) < 1 then Form1.StartStopBtnClick(nil); + end; + + Vu := Vu + a; { Изменяем скорость в соответствии с ускорением } + + Screen.Canvas.Brush.Color := clBlue; + Screen.Canvas.Brush.Style := bsSolid; + Screen.Canvas.Pen.Color := clBlue; { рисуем шар на } + Screen.Canvas.Pen.Style := psSolid;; + Screen.Canvas.Ellipse(T - R, U - R, T + R, U + R); { новой позиции } + end; +end; + +end. + |
