Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.307 RSS
←   Декабрь 2020   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.307 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты в разделе

mklokov
Статус: 10-й класс
Рейтинг: 271
∙ повысить рейтинг » 		puporev
Статус: Профессор
Рейтинг: 108
∙ повысить рейтинг » 		Gluck
Статус: 4-й класс
Рейтинг: 92
∙ повысить рейтинг »

∙ Pascal / Delphi / Lazarus

Номер выпуска:1861
Дата выхода:11.12.2020, 16:45
Администратор рассылки:Зенченко Константин Николаевич (Старший модератор)
Подписчиков / экспертов:40 / 39
Вопросов / ответов:1 / 1

Консультация # 199785: Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос: Есть программа, прикладываю код: 
unit Unit1;

interface

uses
  Window
...

Консультация # 199785:

Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Есть программа, прикладываю код: 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math, ComCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    PaintBox1: TPaintBox;
    EditL: TEdit;
    EditH: TEdit;
    EditNum: TEdit;
    EditRad: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    UpDownNum: TUpDown;
    ButtonGo: TButton;
    ButtonStop: TButton;
    ButtonColor: TButton;
    ButtonFon: TButton;
    ColorDialog1: TColorDialog;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure ButtonFonClick(Sender: TObject);
    procedure ButtonColorClick(Sender: TObject);
    procedure ButtonGoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ButtonStopClick(Sender: TObject);
    procedure UpDownNumClick(Sender: TObject; Button: TUDBtnType);
    procedure EditNumKeyPress(Sender: TObject; var Key: Char);
    procedure ButtonGoKeyPress(Sender: TObject; var Key: Char);
    procedure GroupBox1Click(Sender: TObject);
  private
    { Private declarations }
    procedure Painting;
  public
    { Public declarations }
  end;

type
TMolekula = class
 Fx, Fy, FVx, FVy, FR : Integer;
public
 constructor Create(x, y, Vx, Vy : integer);
 procedure Wall(i : integer; width, height : integer);
 procedure Strike(i : integer);
end;

type
TMolekulaList = Class(TList)
public
 procedure Add(Mol : TMolekula);
 procedure Clear;
 procedure Delete(n : integer);
end;

const MaxSpeed=10;

var
  Form1: TForm1;
  Molcolor: TColor;
  FonColor: TColor;
  Mollist: TMolekulaList;
  pbWidth, pbHeight: integer;
  Rad: integer;

implementation

{$R *.dfm}

Constructor TMolekula.Create(x, y, Vx, Vy : integer);
begin
 Fx := x;
 Fy := y;
 FVx := Vx;
 FVy := Vy;
 FR := Rad;
end;

function CreateMol: TMolekula;
var x, y, vx, vy : integer;
begin
x := RandomRange(Rad, pbWidth - Rad);
y := RandomRange(Rad, pbHeight - Rad);
Vx:= RandomRange(1, MaxSpeed);
Vy:= RandomRange(1, MaxSpeed);
if RandomRange(1, 100) > 50 then Vx := -Vx;
if RandomRange(1, 100) > 50 then Vy := -Vy;
Result := TMolekula.Create(x, y, Vx, Vy);
end;

Function DistanceBetween(Mol1, Mol2 : TMolekula) : real;
begin
 Result:= sqrt(sqr(Mol1.Fx - Mol2.Fx) + sqr(Mol1.Fy - Mol2.Fy));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 MolColor := clBlack;
 FonColor := clSilver;
 MolList := TMolekulaList.Create;
 Randomize;
end;

procedure TForm1.GroupBox1Click(Sender: TObject);
begin

end;

procedure TForm1.ButtonFonClick(Sender: TObject);
begin
if ColorDialog1.Execute then
 FonColor := ColorDialog1.Color;
end;

procedure TForm1.ButtonColorClick(Sender: TObject);
begin
if ColorDialog1.Execute then
 MolColor := ColorDialog1.Color;
end;

procedure TForm1.ButtonGoClick(Sender: TObject);
var i, n : integer;
 Mol : TMolekula;
begin
 PaintBox1.Width := pbWidth;
 PaintBox1.Height := pbHeight;
 pbWidth := StrToInt(editL.Text);
 pbHeight:= StrToInt(editH.Text);
 n := strToInt(editNum.Text);
 Rad := strToInt(editRad.Text);

 if (Rad=0) or (n=0) then
 begin
   ShowMessage ('Количество молекул и/или радиус молекул не могут быть равны 0');
   exit;
 end;

if (pbWidth*pbHeight)<Trunc (n*pi*Rad*Rad) then
begin
  ShowMessage ('Сосуд маленький для таких молекул');
  exit;
end;

 MolList.Clear;

   MolList.Clear;
 for i := 1 to n do
 begin
 Mol := CreateMol;
 MolList.Add(Mol);
 end;
 timer1.Enabled:=true;
 ButtonStop.Caption:= 'Стоп';
end;

procedure TForm1.ButtonGoKeyPress(Sender: TObject; var Key: Char);
begin
if key =#13 then ButtonGo.Click;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var x, y : integer;
 i : integer;
 Mol : TMolekula;
begin
 for i:=0 To MolList.Count-1 do
 begin
 Mol := TMolekula(MolList.Items[i]);
 Mol.Fx := Mol.Fx + Mol.FVx;
 Mol.Fy := Mol.Fy + Mol.FVy;
 Mol.Wall(i, pbwidth, pbheight);
 Mol.Strike(i);
 Painting;
 end;
end;

procedure TForm1.ButtonStopClick(Sender: TObject);
begin
Timer1.Enabled:= not Timer1.Enabled;
if Timer1.Enabled then
 ButtonStop.Caption:= 'Стоп'
else
 ButtonStop.Caption:= 'Продолжить'
end;

procedure TForm1.EditNumKeyPress(Sender: TObject; var Key: Char);
begin
if key =#13 then
begin
ButtonGo.Click;
end;
end;
procedure TForm1.UpDownNumClick(Sender: TObject; Button: TUDBtnType);
var Mol: TMolekula;
begin
if ButtonStop.Caption = 'Стоп' then
 if Button = btNext then
 begin
 Mol := CreateMol;
 MolList.Add(Mol);
 end
 else
 if MolList.Count > 1 then
 MolList.Delete(0);
end;

procedure TMolekula.Wall(i:integer; width, height:integer);
var
Mol : TMolekula;
begin
 Mol := TMolekula(MolList.Items[i]);
 if Mol.Fx + Rad >= width then
 begin
 Mol.FVx := -Mol.FVx;
 Mol.Fx := width - Rad;
 end
 else
 if Mol.Fy + Rad >= height then
 begin
 Mol.FVy := -Mol.FVy;
 Mol.Fy := height - Rad;
 end
 else
 if Rad >= width then
 begin
 Mol.FVx := -Mol.FVx;
 Mol.Fx := width;
 end
 else
 if Rad >= height then
 begin
 Mol.FVy := -Mol.FVy;
 Mol.Fy := height;
 end;
 if Mol.Fx - Rad <= 0 then
 begin
 Mol.FVx := -Mol.FVx;
 Mol.Fx := Rad;
 end
 else
 if Mol.Fy - Rad <= 0 then
 begin
 Mol.FVy := -Mol.FVy;
 Mol.Fy := Rad;
 end;
end;
procedure TMolekula.Strike(i : integer);
var j : byte;
 Mol1, Mol2 : TMolekula;
 temp : integer;
begin
 Mol1:=TMolekula(MolList.Items[i]);
 for j := 0 to MolList.Count - 1 do
 begin
 if j <> i then
  begin
  Mol2 := TMolekula(MolList.Items[j]);
  if DistanceBetween(Mol1, Mol2) <= 2 * Rad then
    begin
    temp := Mol1.FVx;
    Mol1.FVx := Mol2.FVx;
    Mol2.FVx := temp;
    temp := Mol1.FVy;
    Mol1.FVy := Mol2.FVy;
    Mol2.FVy := temp;
    break;
    end;
  end;
 end;
end;

procedure TMolekulaList.Add(Mol: TMolekula);
begin
 inherited Add(Mol);
end;

procedure TMolekulaList.Clear;
var i: integer;
begin
 for i := 0 to Count - 1 do TMolekula(Items[i]).Free;
 Inherited Clear;
end;

procedure TMolekulaList.Delete(n: integer);
begin
 if (n >=0) and (n <= Count - 1) then
 begin
 TMolekula(Items[n]).Free;
 Inherited Delete(n);
 end;
end;

procedure TForm1.Painting;
var
 i : Integer;
 Mol : TMolekula;
begin
 paintBox1.Canvas.Brush.Color := FonColor;
 PaintBox1.Canvas.Rectangle(0, 0, pbWidth, pbHeight);
 PaintBox1.Canvas.Brush.Color := MolColor;
 for i := 0 to MolList.Count - 1 do
 begin
 Mol := TMolekula(MolList.Items[i]);
 PaintBox1.Canvas.Ellipse(Mol.Fx - Rad, Mol.Fy - Rad,
 Mol.Fx + Rad, Mol.Fy + Rad);
 end;
end;

end.


Вопрос: Каким образом написать функцию, вычисляющую среднюю скорость движения молекул по осям, и выводить эти значения на панель параметров.

Дата отправки: 06.12.2020, 01:13
Вопрос задал: Nedix (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »

Консультирует Зенченко Константин Николаевич (Старший модератор):

Здравствуйте, Nedix!

Измените процедуру TForm1.Timer1Timer:

procedure TForm1.Timer1Timer(Sender: TObject);
  var 
    i,x, y : integer;
    Mol : TMolekula;
  begin
    x:=0;
    y:=0;
    for i:=0 To MolList.Count-1 do
      begin
        Mol := TMolekula(MolList.Items[i]);
        Mol.FVx:=Mol.FVx+RandomRange(-1, 1);
	Mol.FVy:=Mol.FVx+RandomRange(-1, 1);
	x:=x+abs(Mol.FVx);
	y:=y+abs(Mol.FVy);
        Mol.Fx := Mol.Fx + Mol.FVx;
        Mol.Fy := Mol.Fy + Mol.FVy;
        Mol.Wall(i, pbwidth, pbheight);
        Mol.Strike(i);
        Painting;
      end;
    Label5.Caption := Format('Средняя скорость по X=%f Y=%f', [X/MoList.Count,Y/MolList.Count]);
  end;


Удачи!

Консультировал: Зенченко Константин Николаевич (Старший модератор)
Дата отправки: 09.12.2020, 17:09

5
Спасибо
-----
Дата оценки: 09.12.2020, 18:27
Рейтинг ответа:

НЕ одобряю 0 одобряю!

Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!
В избранное