Вот весь код программы. Программа рабочая. Но вот что-то мне подсказывает, что в ней много лишнего. Поможете разобраться.
Код:
unit Unit1; // модуль главной формы
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ADODB, DB, Grids, DBGrids, ExtCtrls, DBCtrls, Calendar,
ComCtrls, XPMan, StdCtrls, Math, Spin;
type // типы обьекто созданные конструктором форм делфи
TForm1 = class(TForm)
XPManifest1: TXPManifest;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Image1: TImage;
Label3: TLabel;
Edit3: TEdit;
Button3: TButton;
Edit1: TSpinEdit;
Button4: TButton;
TrackBar1: TTrackBar;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
TrackBar2: TTrackBar;
Label6: TLabel;
Image2: TImage;
procedure FormCreate(Sender: TObject);
// procedure sGetText(Sender: TField; var Text: String;
// DisplayText: Boolean);
procedure MonthCalendar1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
// procedure DBGrid1Enter(Sender: TObject);
// procedure ADOTable1AfterEdit(DataSet: TDataSet);
procedure Button4Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure TrackBar1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
VX,VY,Xc,Yc,Nx,Ny : array of double;
Form1: TForm1;
X,Y :integer;
razm, go : boolean;
a : double;
implementation
{$R *.dfm}
procedure sleep(Value: Cardinal);
var
F, N: Cardinal;
begin
N := 0;
while N <= (Value div 10) do
begin
SleepEx(1, True);
Application.ProcessMessages;
Inc(N);
end;
F := GetTickCount;
repeat
Application.ProcessMessages;
N := GetTickCount;
until (N - F >= (Value mod 10)) or (N < F);
end;
function F_v(r: double):double;
var key,res: double ;
begin // e =8,8541878*10-12
//a:=2*Power(10,-10) ;
//a:=1;
if r=0 then r:=Power(10,-10) ;
//if r>0 then key:=1 else key:=0;
r:=sqrt(r*r) ; // модуль
res:= 4*8.8541878*Power(10,-12)*(Power((a/r),7) - Power((a/r),13));
F_v:=res;
end;
procedure TForm1.FormCreate(Sender: TObject); // при создании формы выполнится
var c: integer;
begin
c:=50;
setlength(Yc,c);
setlength(nX,c); // динамич массив под новую координату каждого атома.
setlength(nY,c);
setlength(vX,c); // скорости
setlength(vY,c);
setlength(Xc,c); // скорости
setlength(Yc,c);
go:=false;
end;
procedure TForm1.MonthCalendar1Click(Sender: TObject); // обработчки клика мышкой по календарю
begin
{DBGrid1.EditorMode:=true;
ADOTable1DSDesigner2.DataSet.Edit; // передаем значения календаря (дату) в поле даты текущего выбранного элемента плана
ADOTable1DSDesigner2.Text :=DateToStr(MonthCalendar1.Date);
}
end;
procedure TForm1.Button3Click(Sender: TObject); // вызовем редактирование сырья формируем отчеты
var j,key_r,x_s,y_s,i,c,x_o,y_o: integer;
begin
PatBlt(image1.Canvas.Handle, 0, 0, image1.ClientWidth, image1.ClientHeight, WHITENESS);
x_o:=50;
y_o:=50;
c:=strtoint(edit1.Text); // сколько атомов
for i:=0 to c-1 do
begin
vx[i]:=0;
vy[i]:=0;
Xc[i] := 0;
yc[i] := 0;
end;
key_r:=0;
for i:=0 to c-1 do
begin
y_s:= random(image1.Height-x_o);
x_s:= random(image1.Width-y_o);
key_r:=1;
while (key_r>0) do begin
key_r:=0 ;
for j:=0 to i do
begin
if ((sqrt((Xc[j]-x_s)*(Xc[j]-x_s))<10 ) or (sqrt((yc[j]-y_s)*(yc[j]-y_s))<10 ) ) then
key_r:=1;
end;
if (key_r>0) then begin
y_s:= random(image1.Height-x_o);
x_s:= random(image1.Width-y_o);
end;
end;
Xc[i] := x_s;
yc[i] := y_s;
// начальные скорости
image1.Canvas.Ellipse(x_o+round(Xc[i])+5,y_o+round(yc[i])+5,x_o+round(Xc[i])-5,y_o+round(yc[i])-5)
end;
razm:=true;
end;
procedure TForm1.Button4Click(Sender: TObject); // вызовем отчет о сегодняшнем дне
var c,i :integer;
begin
go:=false;
razm:=false;
c:=strtoint(edit1.Text); // сколько атомов
for i:=0 to c-1 do
begin
vx[i]:=0;
vy[i]:=0;
Xc[i] := 0;
yc[i] := 0;
end;
PatBlt(image1.Canvas.Handle, 0, 0, image1.ClientWidth, image1.ClientHeight, WHITENESS);
end;
procedure TForm1.Button1Click(Sender: TObject);
var c,i,j,x_o,y_o: integer; key_r,x_s,y_s,step,F,ugol,dx,dy,m, ax,ay,r,fx,fy,dt :double;
begin
a:=(StrToFloat('10E-10'))/5;
x_o:=50;
y_o:=50;
//dt:=1;
step:=round(400/c);
c:=strtoint(edit1.Text); // сколько атомов setlength(Xc,c); // динамич массив под координату каждого атома.
if not razm then Button3.Click;
// razm
go:=true;
while go do // анимация
begin
dt:=(StrToFloat(edit3.Text));
sleep(110-trackbar2.Position*2); // между кадрами/
PatBlt(image1.Canvas.Handle, 0, 0, image1.ClientWidth, image1.ClientHeight, WHITENESS);// очистка
for i:=0 to c-1 do
begin
if (((x_o+xc[i])>0) and ((y_o+yc[i])>0) ) then
image1.Canvas.Ellipse(x_o+round(Xc[i])+5,y_o+round(yc[i])+5,x_o+round(Xc[i])-5,y_o+round(yc[i])-5)
end;
// рисуем заново
for i:=0 to c-1 do
begin
Fx:=0 ; // начальные значения сил
Fy:=0;
for j:=0 to c-1 do // суперпозиция всех векторов. сил
if (i<>j) then begin // не взим с собой
dx:=(Xc[i]-Xc[j]) /10*Power(10,-10); // r маштабу реальному
dy:=(yc[i]-yc[j]) /10*Power(10,-10);
r:=sqrt( dx*dx+dy*dy ); // вектора по модулю
if (r= 0)then r:=Power(10,-10); // слабое вз и все такое
ugol:=ArcCos( dx/r ) ;
F:= F_v(r);// сила действ на i cj стороны j
Fx:=Fx-F*dx/r; // чтобы не анализировать взаимное положение векторов и четность/нечетность триг ф
Fy:=Fy+F*dy/r;
//Fx:=Fx+F*sin(ugol);
// Fy:=Fy-F*cos(ugol); // ось у вниз идет из вехнего угла экрана
// суммуруем силы в проекциях
end;
// отскок от стенки
if ( ((y_o+yc[i])<0) or ((y_o+yc[i])>image1.Height) )then
vy[i]:=-vy[i];
if (((x_o+xc[i])<0) or ((x_o+xc[i])>image1.Width) ) then
vx[i]:=-vx[i];
// вычисляем ускорение и смещение
//1.672 621 637(83) ? 10^27 протон
m:=2*1.672621637*Power(10,-27); // пусть это будет 2 протона
ax:=fx/m;// укорение
ay:=fy/m;
vx[i]:= vx[i]+ax*dt; // сокрость
vy[i]:= vy[i]+ay*dt;
nx[i]:=xc[i]+(vx[i]*dt) *10/Power(10,-10); // смещение в маштабе отображения
ny[i]:=yc[i]-(vy[i]*dt) *10/Power(10,-10);
// теперь у нас есть новые значения коорд для всех атомов
end; // end c каждыйм
for i:=0 to c-1 do
begin
xc[i]:=nx[i] ;
yc[i]:=ny[i] ;
end;
end ; // while end
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if go then begin go:=false; button2.Caption:='Продолжить'; end else begin razm:=true;button2.Caption:='Пауза'; Button1Click(Sender); end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
go:=false;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
edit3.Text:=inttostr(TrackBar1.Position)+'E-15';
end;
end.
15.06.2018, 21:26
Помощь с процедурой и функцией Delphi
Похожие темы
ouble;
