Движение молекул

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OpenGl, DGLUT, Menus;
  const  M=1; // масса молекулы
type
  TForm1 = class(TForm)
    tmr1: TTimer;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure BallDraw(x,y:Double);
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TBall=record
    x,y:Double;
    Vx,Vy:Double;
    id:Byte;
  end;
  TPBall =^TBall;
  procedure SetDCPixelFormat (hdc : HDC);
  procedure Strike(ball1,ball2:TPBall);
  procedure RandomBall;
 
var
  Form1: TForm1;
  Balls:TList;
  DC:HDC;
  hrc:HGLRC;
  ball,ball2:TPBall;
  n:integer;
  r:Double;
implementation
 
uses Unit2;
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);       var i:integer;
begin
 n:=9;
 r:=0.5;
 Randomize;
 DC:= GetDC (Handle);
 SetDCPixelFormat(DC);
 hrc := wglCreateContext(DC);
 wglMakeCurrent(DC, hrc);
 RandomBall;
 glLineWidth(3);
 
end;
 
procedure SetDCPixelFormat (hdc : HDC);
var
 pfd : TPixelFormatDescriptor;
 nPixelFormat : Integer;
begin
 FillChar (pfd, SizeOf (pfd), 0);
 pfd.dwFlags  := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
 nPixelFormat := ChoosePixelFormat (hdc, @pfd);
 SetPixelFormat (hdc, nPixelFormat, @pfd);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 wglMakeCurrent(0, 0);
 wglDeleteContext(hrc);
 ReleaseDC (Handle, DC);
 DeleteDC (DC);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
 glViewport(0, 0, ClientWidth, ClientHeight);
 glLoadIdentity;
 glFrustum (-1, 1, -1, 1, 1, 15);
 glTranslatef(0,0,-3);
 glScalef(3/10,3/10,3/30);
 InvalidateRect(Handle, nil, False);
end;
 
procedure TForm1.tmr1Timer(Sender: TObject);
begin
 Form1.Resize;
end;
 
procedure TForm1.FormPaint(Sender: TObject);      var i,j:integer;  L:double;
begin
 glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 glClearColor(0,0.1,0.2,1);
 
  for i:=0 to n do          // отрисовка шаров + проверка столкновений со стенками
    begin
      ball:=TPBall(Balls[i]);
      BallDraw(ball.x,ball.y);
      ball.x:=ball.x+ball.Vx;
      ball.y:=ball.y+ball.Vy;
 
      if (ball.x <= -10+r) then
        if (ball.Vx<0) then
          ball.Vx:=ball.Vx*(-1);
 
      if (ball.x >=10-r) then
        if (ball.Vx>0) then
          ball.Vx:=ball.Vx*(-1);
 
      if (ball.y <= -10+r) then
        if (ball.Vy<0) then
          ball.Vy:=ball.Vy*(-1);
 
      if (ball.y >=10-r) then
        if (ball.Vy>0) then
          ball.Vy:=ball.Vy*(-1);
 
 
 
      if i<n then                                   // проверка столкновений между шарами
      for j:= i+1 to Balls.Count-1 do
        begin
          ball2:=TPBall(Balls[j]);
          L:=Sqrt(Sqr(ball2.x - ball.x) + Sqr(ball2.y - ball.y));
          if (L <= r + r) then
             Strike(ball,ball2);
        end;
    end;
 
  SwapBuffers(DC);
end;
 
procedure TForm1.BallDraw(x,y:Double);
begin
  glTranslate(x,y,0);
  glColor3f(1,0,0);
 
  glutSolidSphere(r,50,50);
 
  glTranslate(-x,-y,0);
end;
 
procedure Strike(ball1,ball2:TPBall);  var Vcmx,Vcmy:Double;
begin
    Vcmx:=(ball1.Vx * M + ball2.Vx * M) / (M + M);
    Vcmy:=(ball1.Vy * M + ball2.Vy * M) / (M + M);
 
    ball1.Vx:=2 * Vcmx - ball1.Vx;
    ball1.Vy:=2 * Vcmy - ball1.Vy;
    ball2.Vx:=2 * Vcmx - ball2.Vx;
    ball2.Vy:=2 * Vcmy - ball2.Vy;
    while (Sqrt((ball2.x - ball1.x) * (ball2.x - ball1.x) + (ball2.y - ball1.y) * (ball2.y - ball1.y)) <= r + r) do
      begin
        ball1.x:= ball1.x + ball1.Vx * 0.04;
        ball1.y:= ball1.y + ball1.Vy * 0.04;
        ball2.x:= ball2.x + ball2.Vx * 0.04;
        ball2.y:= ball2.y + ball2.Vy * 0.04;
      end;
 
end;
 
 
procedure RandomBall();    var i:integer;
begin
  Balls:=TList.Create;
  Randomize;
 for i:=0 to n do
  begin
    ball:=nil;
    New(ball);
    ball.x:=Random(16)-8+Random(100)/100;
    ball.y:=Random(16)-8+Random(100)/100;
    ball.Vx:=Random(1)/500+Random(100)/500;
    ball.Vy:=Random(1)/500+Random(100)/500;
    ball.id:=i;
    Balls.Add(ball);
  end;
end;
 
procedure TForm1.N4Click(Sender: TObject);
begin
  Close;
end;
 
procedure TForm1.N2Click(Sender: TObject);
begin
  Form2.Show;
end;
 
end.