Текст программы
Ниже приведён текст программы, написанный на языке программирования Delphi 7, для создания на канве броуновского движения молекул.
unit lab;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TMainForm = class(TForm)
Start: TButton;// Объект для запуска программы
InfInput: TLabel;// Объект с информацией о программе
Pict: TImage;// Объект, на который выводится броуновское движение
InputDelay: TEdit;// Окно для ввода длительности паузы
InfLong: TLabel;// Информация о вводе размера массива
InputLong: TEdit;// Окно для ввода массива
InfDelay: TLabel;// Информация о вводе длительности паузы
InfV: TLabel;// Информация о вводе скорости молекулы
InputV: TEdit;// Окно для ввода скорости молекулы
procedure StartClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
point = record
Vx,Vy:integer;
X,Y:integer;
Dir:real;
end;
points=array of point;
var
Form1: TForm1;
implementation
{$R *.dfm}
{Подпрограмма для проверки ввода}
function check(var delay:integer;var long:integer;var V:integer;InputDelay:TEdit;InputLong:TEdit;InputV:TEdit):boolean;
begin
result:=true;
try
if ((strtoint(InputDelay.Text)<=MaxInt)and(strtoint(InputDelay.Text)>-MaxInt)and(strtoint(InputLong.Text)<=MaxInt)and(strtoint(InputLong.Text)>-MaxInt)and(strtoint(InputV.Text)<=MaxInt)and(strtoint(InputV.Text)>-MaxInt)) then
begin
delay:=strtoint(InputDelay.Text);
long:=strtoint(InputLong.Text);
V:=strtoint(InputV.Text);
end
else
result:=false;
except
on EconvertError do
begin
ShowMessage('Ошибка считывания численного значения!!!');
result:=false;
end;
end;
end;
{Подпрограмма для создания динамического массива}
function getmem(var p:points;long:integer):boolean;
begin
SetLength(p,long);
if (p=nil) then
ShowMessage('Ошибка выделения памяти!');
end;
procedure freemem(var p:points;long:integer);
begin
p:=nil
end;
{Подпрограмма для очистки канвы}
procedure clear(var Pict:TImage);
var i,j:integer;
begin
for i:=1 to 385 do
for j:=1 to 345 do
Pict.Canvas.Pixels[i,j]:=clWhite;
end;
{Подпрограмма для создания имитации броуновского движения точек}
procedure TForm1.StartClick(Sender: TObject);
var delay,long,i,V,j,t:integer;
p:points;
begin
if check(delay,long,V,InputDelay,InputLong,InputV) then
begin
SetLength(p,long);
for i:=0 to long-1 do
begin
p[i].Dir:=Random(360)*pi/180;
p[i].X:=random(384);
p[i].Y:=random(344);
end;
j:=0;
repeat
inc(j);
for i:=0 to long-1 do
begin
if (((p[i].X+round(V*sin(p[i].Dir)))<380) and ((p[i].X+round(V*sin(p[i].Dir)))>5)) then
p[i].Vx:=round(V*sin(p[i].Dir))
else
begin
p[i].Vx:=-round(V*sin(-p[i].Dir));
p[i].Dir:=-p[i].Dir;
end;
if (((p[i].Y+round(V*cos(p[i].Dir)))<340)and((p[i].Y+round(V*cos(p[i].Dir)))>5)) then
p[i].Vy:=round(V*cos(p[i].Dir))
else
begin
p[i].Vy:=-round(V*cos(p[i].Dir));
p[i].Dir:=-p[i].Dir;
end;
p[i].X:=p[i].X+p[i].Vx;
p[i].Y:=p[i].Y+p[i].Vy;
Pict.Canvas.Pixels[(p[i].X),(p[i].Y)]:=clBlack;
end;
t:=GetTickCount+delay;
clear(Pict);
repeat
Application.ProcessMessages;
until GetTickCount-t>=1000;
until (not(j<>long*2));
freemem(p,long);
end;
end;
end.