From c1147629f7aae2ee90ccd7c9f1ccbf106361d486 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 13 Dec 2025 16:35:46 +0100 Subject: =?UTF-8?q?Add=20book=20"=D0=97=D0=B0=D0=BD=D0=B8=D0=BC=D0=B0?= =?UTF-8?q?=D1=82=D0=B5=D0=BB=D1=8C=D0=BD=D0=BE=D0=B5=20=D0=BF=D1=80=D0=BE?= =?UTF-8?q?=D0=B3=D1=80=D0=B0=D0=BC=D0=BC=D0=B8=D1=80=D0=BE=D0=B2=D0=B0?= =?UTF-8?q?=D0=BD=D0=B8=D0=B5"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../1/8_4_life/unit1.pas" | 158 +++++++++++++++++++++ 1 file changed, 158 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/1/8_4_life/unit1.pas" (limited to 'Занимательное программирование/1/8_4_life/unit1.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/1/8_4_life/unit1.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/1/8_4_life/unit1.pas" new file mode 100644 index 0000000..b5d4702 --- /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/1/8_4_life/unit1.pas" @@ -0,0 +1,158 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, + Math; + +const FieldWidth = 30; { Ширина и } + FieldHeight = 25; { высота поля } + +type + + TField = array [0..FieldWidth + 1, 0..FieldHeight + 1] of Boolean; + + TPoint = record + x: Integer; + y: Integer; + end; + + { TForm1 } + + TForm1 = class(TForm) + Screen: TPaintBox; + StartStopBtn: TButton; + procedure ScreenPaint(Sender: TObject); + procedure StartStopBtnClick(Sender: TObject); + private + procedure UpdateSurface(field: TField; point: TPoint; neighbours: Integer); + var Rx, Ry: Integer; { Ширина, высота клекти } + BlueField, GreenField: TField; + s, v: Integer; + bluePoint, greenPoint: TPoint; + public + + end; + +var + Form1: TForm1; + IsRunning: Boolean; + +implementation + +{$R *.lfm} + +function CountNeighbours(Field: TField; x: Integer; y: Integer): Integer; + var i, j: Integer; +begin + Result := 0; + + for i := -1 to 1 do + for j := -1 to 1 do + Result := Result + Ord(Field[x + i][y + j]); + Result := Result - Ord(Field[x][y]); +end; + +{ Выбираем случайную клекту } +function ChoosePoint(): TPoint; +begin + Result.x := RandomRange(1, FieldWidth); + Result.y := RandomRange(1, FieldHeight); +end; + +{ TForm1 } + +procedure TForm1.StartStopBtnClick(Sender: TObject); + var i, j: Integer; +begin + if IsRunning then + begin + IsRunning := false; + StartStopBtn.Caption := 'Пуск'; + Exit; + end; + + StartStopBtn.Caption := 'Стоп'; + IsRunning := true; + + Rx := (Screen.Width div FieldWidth) div 2; { Определяем размеры клетки } + Ry := (Screen.Height div FieldHeight) div 2; + + Randomize; + + for i := 0 to FieldWidth + 1 do { Очистка поля } + for j := 0 to FieldHeight + 1 do + begin + BlueField[i, j] := false; + GreenField[i, j] := false; + end; + + while IsRunning do { Основной цикл } + begin + bluePoint := ChoosePoint(); + greenPoint := ChoosePoint(); + + s := CountNeighbours(BlueField, bluePoint.x, bluePoint.y); + v := CountNeighbours(GreenField, greenPoint.x, greenPoint.y); + + Screen.Invalidate; + + Sleep(250); + Application.ProcessMessages; + if Application.Terminated then Exit; + end +end; + +procedure TForm1.UpdateSurface(field: TField; point: TPoint; neighbours: Integer); +begin + if (field[point.x, point.y] = false) and (neighbours > 2) then { Создаем новую инфузорию } + begin + Screen.Canvas.Pen.Color := clBlue; + Screen.Canvas.Ellipse((2 * point.x - 1) * Rx - Rx, (2 * point.y - 1) * Ry - Ry, + (2 * point.x - 1) * Rx + Rx, (2 * point.y -1) * Ry + Ry); + field[point.x, point.y] := true; + end + else if (field[point.x, point.y] = true) and ((neighbours < 3) or (neighbours > 4)) then { Удаляем } + begin + Screen.Canvas.Pen.Color := clBtnFace; + Screen.Canvas.Ellipse((2 * point.x - 1) * Rx - Rx, (2 * bluePoint.y - 1) * Ry - Ry, + (2 * point.x - 1) * Rx + Rx, (2 * point.y -1) * Ry + Ry); + field[point.x, point.y] := false; + end; +end; + +procedure TForm1.ScreenPaint(Sender: TObject); + var i, j: Integer; +begin + Screen.Canvas.Pen.Color := clBlue; + + for i := 1 to FieldWidth do { Создаем начальную конфигурацию } + for j := 1 to FieldHeight do + if Random(4) = 0 then { В среднем будет одна инфузория } + begin { на четыре клетки } + BlueField[i, j] := true; + Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry, + (2 * i - 1) * Rx + Rx, (2 * j - 1) * Ry + Ry); + end; + + UpdateSurface(blueField, bluePoint, s); + + Screen.Canvas.Pen.Color := clGreen; + + for i := 1 to FieldWidth do { Создаем начальную конфигурацию } + for j := 1 to FieldHeight do + if Random(4) = 0 then { В среднем будет одна инфузория } + begin { на четыре клетки } + GreenField[i, j] := true; + Screen.Canvas.Ellipse((2 * i - 1) * Rx - Rx, (2 * j - 1) * Ry - Ry, + (2 * i - 1) * Rx + Rx, (2 * j - 1) * Ry + Ry); + end; + + UpdateSurface(greenField, greenPoint, v); +end; + +end. + -- cgit v1.2.3