Уроки, алгоритмы, программы, примеры

Вход на сайт

Материалы по разделам

Построения
на плоскости (2D)
Графика
в пространстве (3D)
Вычислительная
геометрия
Физическое
моделирование
Фрактальная
графика

Новые комментарии

огромное спасибо за подробное объяснение про 3д графику на питоне, в интернете очень мало подобной информации
dobryj den, popytalas otkryt prikreplionnyj fail ctoby posmotret kak rabotaet, no mne ego ne pokazyvaet vydajet osibku. Pochemu?
Очень интересно! ии сайт крутой жалко что умирает(
У Вас число превысит максимальное число int. Можно использовать в Вашем случае uint, но лучше все переписать на double.
Добавление к программе строки glutReshapeFunc(changeSize); приводит к тому, что треугольник перестаёт совсем отрисовываться.

Счетчики и рейтинг

Рейтинг@Mail.ru Яндекс.Метрика
Скриншот к примеру
Среда программирования: 
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.zip108.31 кб
Project1.zip197.54 кб