Add book "Занимательное программирование"

Занимательное программирование/1/3_brownian_motion/unit1.pas

@@ -0,0 +1,214 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
+  Math;
+
+type
+
+  Coordinate = record
+    X, Y: Integer;
+  end;
+
+  Molecule = record
+    X, Y: Integer;
+    Vx, Vy: Integer;
+    { Указывает на столкновение с броуновской
+    частицей во время предыдущей итерации }
+    WasCollision: Boolean;
+  end;
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Path: TPaintBox;
+    StartStopBtn: TButton;
+    Screen: TPaintBox;
+    procedure PathPaint(Sender: TObject);
+    procedure StartStopBtnClick(Sender: TObject);
+    procedure ScreenPaint(Sender: TObject);
+  private
+    const R: Integer = 10; { Радиус молекулы }
+      V: Integer = 7; { Максимальная скорость молекулы }
+      N = 30; { Количество молекул }
+      Rb: Integer = 60; { Радиус броуновской частицы }
+      K: Real = 0.01; { "Коэффициент передачи" }
+    var Mol: array[1..N] of Molecule; { Массив молекул }
+      Xb, Yb: Real; { Координаты броуновской частицы }
+      Vxb, Vyb: Real; { Составляющие скорости броуновской частицы }
+      Points: array of Coordinate;
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+  IsRunning: Boolean = false;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.ScreenPaint(Sender: TObject);
+  var i: Integer;
+begin
+  if not IsRunning then Exit;
+
+  for i := 1 to N do { Цикл по всем молекулам }
+  begin
+    Screen.Canvas.Pen.Color := clBtnFace; { Стираем молекулу }
+    Screen.Canvas.Ellipse(Mol[i].X - R, Mol[i].Y - R,
+      Mol[i].X + R, Mol[i].Y + R);
+
+    Mol[i].X := Mol[i].X + Mol[i].Vx; { Сдвигаем на новую позицию }
+    Mol[i].Y := Mol[i].Y + Mol[i]. Vy;
+
+    { Определяем, не вышла ли молекула за границы аквариума }
+    if Mol[i].X > Screen.Width - R then
+    begin
+      Mol[i].X := Screen.Width - R;
+      Mol[i].Vx := -Mol[i].Vx;
+    end;
+    if Mol[i].X < R then
+    begin
+      Mol[i].X := R;
+      Mol[i].Vx := -Mol[i].Vx;
+    end;
+    if Mol[i].Y > Screen.Height - R then
+    begin
+      Mol[i].Y := Screen.Height - R;
+      Mol[i].Vy := -Mol[i].Vy;
+    end;
+    if Mol[i].Y < R then
+    begin
+      Mol[i].Y := R;
+      Mol[i].Vy := -Mol[i].Vy;
+    end;
+
+    Screen.Canvas.Pen.Color := clBlue; { Рисуем молекулу на новой }
+    Screen.Canvas.Ellipse(Mol[i].X - R, Mol[i].Y - R, { позиции }
+      Mol[i].X + R, Mol[i].Y + R);
+
+    if Sqrt((Mol[i].X - Xb) * (Mol[i].X - Xb) + { Если произошло столкновение }
+      (Mol[i].Y - Yb) * (Mol[i].Y - Yb)) < Rb + R then
+    begin
+      if Mol[i].WasCollision = false then { Если на предыдущей итерации }
+      begin { эта молекула не сталкивалась с }
+        Vxb := Vxb + K * Mol[i].Vx; { частицей, обрабатываем }
+        Vyb := Vyb + K * Mol[i].Vy; { столкновение }
+      end;
+      { На данной итерации i-я молекула столкнулась с броуновской частицей }
+      Mol[i].WasCollision := true;
+    end
+    else
+      Mol[i].WasCollision := false;
+  end;
+
+  Screen.Canvas.Pen.Color := clBtnFace; { Стереть частицу с экрана }
+  Screen.Canvas.Ellipse(Round(Xb - Rb), Round(Yb - Rb),
+    Round(Xb + Rb), Round(Yb + Rb));
+
+  Xb := Xb + Vxb; { Сдвинуть на новую позицию }
+  Yb := Yb + Vyb;
+
+  if Xb > Screen.Width - Rb then { Обработать отражения от стенок аквариума }
+  begin
+    Xb := Screen.Width - Rb;
+    Vxb := -Vxb;
+  end;
+  if Xb < Rb then
+  begin
+    Xb := Rb;
+    Vxb := -Vxb;
+  end;
+  if Yb > Screen.Height - Rb then
+  begin
+    Yb := Screen.Height - Rb;
+    Vyb := -Vyb;
+  end;
+  if Yb < Rb then
+  begin
+    Yb := Rb;
+    Vyb := -Vyb;
+  end;
+
+  if (Length(points) < (Screen.Width - Rb) * (Screen.Height - Rb)) and
+    (Round(Xb) mod 2 = 0) and (Round(Yb) mod 2 = 0) then
+  begin
+    SetLength(points, Length(points) + 1);
+    points[Length(points) - 1].X := Round(Xb);
+    points[Length(points) - 1].Y := Round(Yb);
+  end;
+
+  Screen.Canvas.Pen.Color := clRed; { Нарисовать частицу на новом месте }
+  Screen.Canvas.Ellipse(Round(Xb - Rb), Round(Yb - Rb),
+    Round(Xb + Rb), Round(Yb + Rb));
+end;
+
+procedure TForm1.StartStopBtnClick(Sender: TObject);
+  var angle: Real; { Угол, задающий изначальное направление полета }
+    i: Integer; { Счетчик цикла }
+    CurV: Integer; { Выбранная случайная скорость молекулы }
+begin
+  if IsRunning then
+  begin
+    IsRunning := false;
+    StartStopBtn.Caption := 'Пуск';
+    Exit;
+  end;
+
+  StartStopBtn.Caption := 'Стоп';
+  IsRunning := true;
+
+  Randomize;
+
+  Xb := Screen.Width div 2;
+  Yb := Screen.Height div 2;
+  Vxb := 0;
+  Vyb := 0;
+
+  for i := 1 to N do { Цикл по всем молекулам }
+  begin
+    Mol[i].X := RandomRange(R, Screen.Width - R); { Выбор начального }
+    Mol[i].Y := RandomRange(R, Screen.Height - R); { положения молекулы }
+    angle := Random(360) * Pi / 180; { и ее направления }
+
+    CurV := RandomRange(1, V); { Выбор скорости молекулы (1 - V) }
+    Mol[i].Vx := Round(CurV * Sin(angle)); { Получение составляющих }
+    Mol[i].Vy := Round(CurV * Cos(angle)); { скорости молекулы }
+
+    Mol[i].WasCollision := false;
+  end;
+
+  while IsRunning do { Основной цикл }
+  begin
+    Screen.Invalidate;
+    Path.Repaint;
+    Sleep(10); { Пауза на 10 миллисекунд }
+    Application.ProcessMessages;
+    if Application.Terminated then Break;
+  end;
+
+end;
+
+procedure TForm1.PathPaint(Sender: TObject);
+  var i: Integer;
+begin
+  if Length(points) = 0 then Exit;
+  Screen.Canvas.Pen.Color := clBlue;
+
+  for i := 0 to Length(points) do
+  begin
+    Path.Canvas.Rectangle(points[i].X - 1, points[i].Y - 1,
+      points[i].X + 1, points[i].Y + 1);
+  end;
+end;
+
+end.
+