Old circle collision project

Focuson.pas

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    WorkTimer: TTimer;
    RenderTimer: TTimer;
    Panel1: TPanel;
    Panel2: TPanel;
    BitBtn1: TBitBtn;
    shapes: TLabeledEdit;
    UpDown1: TUpDown;
    angle: TMaskEdit;
    velocity: TMaskEdit;
    Label1: TLabel;
    Label2: TLabel;
    pause: TBitBtn;
    info: TBitBtn;
    clear: TBitBtn;
    speed: TTrackBar;
    Label3: TLabel;
    alpha_val: TEdit;
    Label4: TLabel;
    D_val: TEdit;
    Label5: TLabel;
    exp_write: TMemo;
    total_write: TMemo;
    Edit3: TEdit;
    lbDisplay: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Label6: TLabel;
    Edit6: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    delExp: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure WorkTimerTimer(Sender: TObject);
    procedure pauseClick(Sender: TObject);
    procedure RenderTimerTimer(Sender: TObject);
    procedure clearClick(Sender: TObject);
    procedure infoClick(Sender: TObject);
    procedure speedChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure delExpClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;
  vx,vy,x,y,teta,energy:array[1..30] of real;
  q:array[1..9] of real;
  i,j,k,collnumber,expnumber,Nexp:integer;
  A,B,C,S:real;
  u1,u2,u3,u4:real;
  t1,t2,t3,t4:real;
  meanLambda,Ef: real;
  Circl:array[1..30] of TShape;
  log:boolean;
  gettime:real;
  f:file;
  p:string;
  searchResult : TSearchRec;

implementation

uses Unit2;

{$R *.dfm}

procedure InitProcedure;
begin
   with Form1 do
   begin
   exp_write.Lines.Clear;
   teta[1]:=strtofloat(angle.Text);
   vx[1]:=strtofloat(velocity.Text)*cos(teta[1]*Pi/180);   //Ввод скоростей
   vy[1]:=strtofloat(velocity.Text)*sin(teta[1]*Pi/180);
   energy[1]:=sqr(strtofloat(velocity.Text));
   randomize;
   for i:=1 to k*3 do
   begin
    Circl[i]:=TShape.Create(Panel2);
    Circl[i].Parent:=Panel2;
    Circl[i].Shape:=stCircle;           //Создание шаров
    Circl[i].Width:=Round(strtoint(D_val.Text)/strtofloat(alpha_val.Text));
    Circl[i].Height:=Round(strtoint(D_val.Text)/strtofloat(alpha_val.Text));
    x[i]:=25+strtoint(D_val.Text)*trunc(i/3);
    case i div 3 of
    2: y[i]:=Panel2.Height-round(Panel2.Height/4);
    1: y[i]:=Panel2.Height-round(Panel2.Height/2);
    0: y[i]:=Panel2.Height-round(3*Panel2.Height/4);
    end;
   end;
   exp_write.Lines[0]:='alpha = '+floattostr(strtoint(D_val.Text)/Circl[2].Height);
   exp_write.Lines.Add('1     '+floattostrf(teta[1],ffFixed,6,5)+
      '      '+floattostrf(energy[1],ffFixed,6,5));
   collnumber:=0;
   lbDisplay.Caption:='Эксперимент #'+inttostr(expnumber);
   for i:=1 to k*3 do
    begin
    Circl[i].Left:=round(x[i]);
    Circl[i].Top:=round(y[i]);
    end;
   end;
end;

procedure StopProcedure;
begin
   for i:=1 to k*3 do
    begin
    Circl[i].Destroy;
    vx[i]:=0;
    vy[i]:=0;
    end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin;
gettime:=Now;
k:=strtoint(shapes.Text);
Nexp:=strtoint(Edit3.Text);
expnumber:=1;
BitBtn1.Enabled:=false;
pause.Enabled:=true;
RenderTimer.Enabled:=true;
WorkTimer.Enabled:=true;
clear.Enabled:=true;
total_write.Clear;
total_write.Lines[0]:='alpha = '+floattostr(strtoint(D_val.Text)/(strtoint(D_val.Text)/strtofloat(alpha_val.Text)));;
InitProcedure;
end;

procedure TForm1.WorkTimerTimer(Sender: TObject);
begin
     if not directoryExists('save') then
     createDir('save');
     for i:=1 to k*3 do
         begin
         x[i]:=x[i]+vx[i];
         y[i]:=y[i]-vy[i];
         end;
      if (collnumber=3*k-1) then
        begin
        p:=Timetostr(gettime);
        j:=length(p);
        for i:=1 to j do if p[i]=':' then p[i]:='-';
        exp_write.Lines.SaveToFile('save/'+p+'_exp_'+inttostr(expnumber)+'.txt');
        if (expnumber=Nexp) and (log=false) then
        begin
        total_write.Lines.SaveToFile('save/'+p+'_total.txt');
        log:=true;
        end;
          if (expnumber=Nexp) then exit else
            begin
              inc(expnumber);
              StopProcedure;
              InitProcedure;
              alpha_val.Text:=floattostr(strtofloat(alpha_val.Text)+strtofloat(Edit6.Text));
            end;
        end;
      i:=collnumber+1;
      j:=i+1;
      u1:=x[i]+Circl[i].Height/2;
      u2:=x[j]+Circl[j].Height/2;
      u3:=y[i]+Circl[i].Height/2;
      u4:=y[j]+Circl[j].Height/2;

      S:=sqr(u2-u1)+sqr(u4-u3);

      t1:=vx[i];
      t2:=vy[i];
      t3:=vx[j];
      t4:=vy[j];

      if S<=sqr(Circl[i].Height) then
        begin
          A:=(sqr(u4-u3))/S;
          B:=-((u4-u3)*(u2-u1))/S;
          C:=(sqr(u2-u1))/S;
          vx[i]:=(A*t1-B*t2+C*t3+B*t4);
          vy[i]:=(-B*t1+C*t2+B*t3+A*t4);
          vx[j]:=(C*t1+B*t2+A*t3-B*t4);
          vy[j]:=(B*t1+A*t2-B*t3+C*t4);
          teta[j]:=arctan(vy[j]/vx[j])*180/Pi;
          energy[j]:=sqr(vx[j])+sqr(vy[j]);
          exp_write.Lines.Add(inttostr(j)+'     '+floattostrf(teta[j],ffFixed,6,5)+
            '      '+floattostrf(energy[j],ffFixed,6,5));
          inc(collnumber);
          if (collnumber=k-1) then
            begin
               meanLambda:=power(abs(teta[k]/teta[1]),1/(k-1));
               Ef:=energy[k]/energy[1];
               total_write.Lines.Add(inttostr(expnumber)+'     '+
                floattostrf(meanLambda,ffFixed,6,5)+
                '      '+floattostrf(Ef,ffFixed,6,5));

            end;
        end;
             end;

procedure TForm1.pauseClick(Sender: TObject);
begin
     RenderTimer.Enabled:=not RenderTimer.Enabled;
     WorkTimer.Enabled:=not WorkTimer.Enabled;
end;


procedure TForm1.RenderTimerTimer(Sender: TObject);
begin
for i:=1 to k*3 do
    begin
    Circl[i].Left:=round(x[i]);
    Circl[i].Top:=round(y[i]);
    end;
end;


procedure TForm1.clearClick(Sender: TObject);
begin
     if messagebox(handle,pchar('Это действие перезагрузит программу. Вы уверены?'),pchar('Перезагрузка'),MB_ICONWARNING+mb_OKCANCEL+mb_defbutton1)=1 then
     begin
          pause.Caption:='Пауза';
          RenderTimer.Enabled:=false;
          WorkTimer.Enabled:=false;
          StopProcedure;
          BitBtn1.Enabled:=true;
          info.Enabled:=false;
          clear.Enabled:=false;
          pause.Enabled:=false;
          exp_write.Clear;
          total_write.Clear;
          log:=false;
     end;
     
end;


procedure TForm1.infoClick(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.speedChange(Sender: TObject);
begin
     WorkTimer.Interval:=(speed.Max-speed.Position)*speed.Max+1;
     RenderTimer.Interval:=(speed.Max-speed.Position)*speed.Max+1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if not directoryExists('save') then
createDir('save');
end;

Function AllDeleteDir(sDir : String) : Boolean;
var 
iIndex : Integer; 
SearchRec : TSearchRec; 
sFileName : String; 
begin 
Result := False; 
sDir := sDir + '\*.*'; 
iIndex := FindFirst(sDir, faAnyFile, SearchRec);

while iIndex = 0 do begin 
sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name; 
if SearchRec.Attr = faDirectory then begin 
if (SearchRec.Name <> '' ) and 
(SearchRec.Name <> '.') and
(SearchRec.Name <> '..') then 
AllDeleteDir(sFileName); 
end else begin 
if SearchRec.Attr <> faArchive then 
FileSetAttr(sFileName, faArchive); 
if NOT DeleteFile(sFileName) then 
ShowMessage('Could NOT delete ' + sFileName); 
end; 
iIndex := FindNext(SearchRec); 
end;

FindClose(SearchRec);

RemoveDir(ExtractFileDir(sDir)); 
Result := True; 
end;

procedure TForm1.delExpClick(Sender: TObject);
begin
     if messagebox(handle,pchar('Это действие не только очистит поля, но и удалит файлы вывода. Вы уверены?'),pchar('Очистка вывода'),MB_ICONWARNING+mb_OKCANCEL+mb_defbutton1)=1 then
     begin
     exp_write.Clear;
     total_write.Clear;
     AllDeleteDir('save');
     end;
end;

end.