
Среда программирования:
Borland Delphi 7.0
Статья по теме:
Программа демонстрирует процесс движения моллекул в идеальном газе. Для выбора параметров откройте вкладку "Меню".
Код программы:
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.
Прикрепленный файл | Размер |
---|---|
Balls.zip | 108.31 кб |
Project1.zip | 197.54 кб |