Достать анимацию капель

unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, OpenGL, BMP;
 
const
  GridSize = 63;
  RAIN_TIMER = 2;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
type TGLCoord = Record
       X, Y, Z : glFloat;
end;
 
var
  Form1: TForm1;
  h_DC   : HDC;                      //    (контекст воспроизведения) окна, на который будет осуществляться вывод.
  h_RC   : HGLRC;                    //    OpenGL ссылке на контекст воспроизведения
 
  ElapsedTime : Integer;             // Elapsed time between frames   Прошедшее время между кадрами
  keys : Array[0..255] of Boolean;   // Holds keystrokes   Держит нажатия клавиш
 
  // Textures   Текстуры
  WaterTexture, WoodTexture : glUint;
  // User vaiables   Vaiables Система
  RainInterval : Integer;
  Viscosity : glFloat;
  Position : Array[0..GridSize, 0..GridSize] of glFloat;
  Velocity : Array[0..GridSize, 0..GridSize] of glFloat;
  Vertex : Array[0..GridSize, 0..GridSize] of TglCoord;
  Normals:array [0..GridSize, 0..GridSize] of TglCoord;
  xAngle, yAngle : glFloat;
 
implementation
 
{$R *.dfm}
 
procedure DrawWater;
var I, J : Integer;
    VectLength : glFloat;
begin
  // Calculate new velocity   Рассчитать новую скорость
  For I :=2 to GridSize-2 do
    For J :=2 to GridSize-2 do
      Velocity[I, J] := Velocity[I, J] + (Position[I, J] -
              (4*(Position[I-1,J] + Position[I+1,J] + Position[I,J-1] + Position[I,J+1]) +  // left, right, above, below   слева, справа, сверху, снизу
              Position[I-1,J-1] + Position[I+1,J-1] + Position[I-1,J+1] + Position[I+1,J+1])/25) / 7;  // diagonally across   по диагонали
 
  // Calculate the new ripple positions   Рассчитать новые позиции рябь
  For I:=2 to GridSize-2 do
    For J:=2 to GridSize-2 do
    Begin
      Position[I, J] := Position[I, J] - Velocity[I,J];
      Velocity[I, J] := Velocity[I, J] * Viscosity;
    End;
 
  // Calculate the new vertex coordinates   Рассчитать координаты вершин новых
  For I :=0 to GridSize do
    For J :=0 to GridSize do
    begin
      Vertex[I, J].X :=(I - GridSize/2)/GridSize*5;
      Vertex[I, J].Y :=(Position[I, J] / 1024)/GridSize*3;
      Vertex[I, J].Z :=(J - GridSize/2)/GridSize*5;
    end;
 
  // Calculate the new vertex normals.   Рассчитать новые нормали вершин.
  // Do this by using the points to each side to get the right angle   Сделайте это с помощью точки с каждой стороны, чтобы получить правильный угол
  For I :=0 to GridSize do
  begin
    For J :=0 to GridSize do
    begin
      If (I > 0) and (J > 0) and (I < GridSize) and (J < GridSize) then
      begin
        with Normals[I, J] do
        begin
          X := Position[I+1, J] - Position[I-1,J];
          Y := -2048;
          Z := Position[I, J+1] - Position[I, J-1];
 
          VectLength :=sqrt(x*x + y*y + z*z);
          if VectLength <> 0 then
          begin
            X :=X/VectLength;
            Y :=Y/VectLength;
            Z :=Z/VectLength;
          end;
        end;
      end
      else
      begin
        Normals[I, J].X :=0;
        Normals[I, J].Y :=1;
        Normals[I, J].Z :=0;
      end;
    end;
  end;
 
  // Draw the water texture   Нарисуйте текстуру воды
  glBindTexture(GL_TEXTURE_2D, WaterTexture);
  For J :=0 to GridSize-1 do
  begin
    glBegin(GL_QUAD_STRIP);
      for I :=0 to GridSize do
      begin
        glNormal3fv(@Normals[I, J+1]);
//        glTexCoord2f(I/GridSize, (J+1)/GridSize);
        glVertex3fv(@Vertex[I, J+1]);
        glNormal3fv(@Normals[I, J]);
//        glTexCoord2f(I/GridSize, J/GridSize);
        glVertex3fv(@Vertex[I, J]);
      end;
    glEnd;
  end;
end;
 
{------------------------------------------------------------------}
{  Function to draw the actual scene  Функция привлечь фактическое сцену                             }
{------------------------------------------------------------------}
procedure glDraw();
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    // Clear The Screen And The Depth Buffer   Очистите экран и буфер глубины
  glLoadIdentity();                                       // Reset The View   Сброс Фото
 
  glTranslatef(0.0,0.2,-4.5);
 
  glRotatef(xAngle, 1, 0, 0);
  glRotatef(yAngle, 0, 1, 0);
 
 
  glColor3f(0.85, 1, 0.85);
  DrawWater;
end;
 
procedure CreateRainDrop;
begin
  Velocity[random(GridSize-3)+2, random(GridSize-3)+2] :=1060;
end;
 
{------------------------------------------------------------------}
{  Processes all the keystrokes   Процессы все нажатия клавиш                                 }
{------------------------------------------------------------------}
procedure ProcessKeys;
begin
  if (keys[VK_UP])    then xAngle := xAngle - 0.5;
  if (keys[VK_DOWN])  then xAngle := xAngle + 0.5;
  if (keys[VK_RIGHT]) then yAngle := yAngle - 0.5;
  if (keys[VK_LEFT])  then yAngle := yAngle + 0.5;
 
  if (keys[VK_SPACE]) then
  begin
    CreateRainDrop;
    keys[VK_SPACE] :=FALSE;
  end;
 
  if (keys[VK_ADD]) then
  begin
    if RainInterval > 100 then
      RainInterval :=RainInterval - 100
    else
      RainInterval :=25;
    CreateRainDrop;
    SetTimer(h_DC, RAIN_TIMER, RainInterval, nil);
    keys[VK_ADD] :=FALSE;
  end;
  if (keys[VK_SUBTRACT]) then
  begin
    RainInterval :=RainInterval + 100;
//    CreateRainDrop;
    SetTimer(h_DC, RAIN_TIMER, RainInterval, nil);
    keys[VK_SUBTRACT] :=FALSE;
  end;
end;
 
{------------------------------------------------------------------}
{  Initialise OpenGL    Инициализирует OpenGL                                              }
{------------------------------------------------------------------}
procedure glInit();
var I, J : Integer;
begin
  glClearColor(0.0, 0.0, 0.0, 0.0);        // Black Background   Черный фон
  glShadeModel(GL_SMOOTH);                 // Enables Smooth Color Shading   Позволяет Smooth Color Shading
  glClearDepth(1.0);                       // Depth Buffer Setup   Глубина буфера Настройка
  glEnable(GL_DEPTH_TEST);                 // Enable Depth Buffer   Включить буфер глубины
  glDepthFunc(GL_LESS);                // The Type Of Depth Test To Do   Тип глубины тест делать
  glBlendFunc(GL_SRC_COLOR, GL_ONE);
 
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);   //Realy Nice perspective calculations   Realy Ницца перспективные расчеты
 
  glEnable(GL_TEXTURE_2D);               // Enable Texture Mapping   Включить Texture Mapping
  LoadTexture('wood1.bmp', WoodTexture);    // Load the Texture   Загрузите текстуру
  LoadTexture('reflection.bmp', WaterTexture);    // Load the Texture   Загрузите текстуру
 
  // enable spherical environment maping   включить сферическую среды Maping
  glEnable(GL_BLEND);
  glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
  glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
  glEnable(GL_TEXTURE_GEN_S);
  glEnable(GL_TEXTURE_GEN_T);
 
  Viscosity :=0.96;
  For I :=0 to GridSize do
  begin
    For J :=0 to GridSize do
    begin
      Position[I, J] :=0;
      Velocity[I, J] :=0;
    end;
  end;
 
  // Initializes the rain drop timer   Инициализирует таймер падение дождь
  RainInterval :=1000;
  SetTimer(h_DC, RAIN_TIMER, RainInterval, nil);
 
  Randomize;
  xAngle :=35;
  yAngle :=20;
end;
 
procedure SetDCPixelFormat ( h_Wnd : HDC );
var
  PixelFormat : GLuint;         // Settings for the OpenGL rendering   Установки для оказания OpenGL
  pfd : TPIXELFORMATDESCRIPTOR;  // Settings for the OpenGL window   Настройки для окна OpenGL
begin
  FillChar (pfd, SizeOf (pfd), 0);        // Теперь заполняем массив значением 1
  // Попытки найти формат пикселя поддерживается контекста устройства, что является лучшим матч для данного формата пикселей спецификации.
  PixelFormat := ChoosePixelFormat(h_Wnd, @pfd);
  if (PixelFormat = 0) then
  begin
//    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
//    Result := False;
    Form1.Close;
  end;
 
  // Устанавливает формат указанном контексте устройства в пиксель в формате, указанном PixelFormat.
  if (not SetPixelFormat(h_Wnd, PixelFormat, @pfd)) then
  begin
//    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
//    Result := False;
    Form1.Close;
  end;
 
    // Create a OpenGL rendering context   Создать контекст OpenGL рендеринга
  h_RC := wglCreateContext(h_Wnd);
  if (h_RC = 0) then
  begin
//    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
//    Result := False;
    Form1.Close;
  end;
 
  // Делает заданный контекст OpenGL рендеринга текущий контекст рендеринга вызывающего потока
  if (not wglMakeCurrent(h_Wnd, h_RC)) then
  begin
//    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
//    Result := False;
    Form1.Close;
  end;
 
end;
 
procedure WinMain(); stdcall;
var
  msg : TMsg;
  finished : Boolean;
  DemoStart, LastTime : DWord;
  h_Wnd  : HWND;
begin
  finished := False;
  h_Wnd:=GetDC(Form1.Panel1.Handle);
  h_DC:=h_Wnd;
  SetDCPixelFormat(h_Wnd);
  glInit(); // Инициализирует OpenGL
 
  DemoStart := GetTickCount();            // Get Time when demo started   Получить время, когда демо начал
 
    // Main message loop:
  while not finished do
  begin
    if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then // Check if there is a message for this window   Проверьте, есть ли сообщение для данного окна
    begin
      if (msg.message = WM_QUIT) then     // If WM_QUIT message received then we are done   Если WM_QUIT сообщение получил то мы сделали
        finished := True
      else
      begin                               // Else translate and dispatch the message to this window   Остальное перевести и отправить сообщение на этом окне
        TranslateMessage(msg);
        DispatchMessage(msg);
      end;
    end
    else
    begin
 
      LastTime :=ElapsedTime;
      ElapsedTime :=GetTickCount() - DemoStart;     // Calculate Elapsed Time   Рассчитать прошедшее время
      ElapsedTime :=(LastTime + ElapsedTime) DIV 2; // Average it out for smoother movement   Нормальное его для более плавного движения
 
      glDraw();                           // Draw the scene   Нарисуйте сцены
      SwapBuffers(h_DC);                  // Display the scene   Отображение сцены
 
      if (keys[VK_ESCAPE]) then           // If user pressed ESC then set finised TRUE   Если пользователь нажал клавишу ESC, то набор finised ИСТИНА
        finished := True
      else
        ProcessKeys;                      // Check for any other key Pressed   Проверьте любой другой нажатой клавиши
    end;
  end;
 
  //Завершить
  Form1.Close;
 
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  WinMain();
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
//   glClearColor (0.5, 0.5, 0.75, 1.0); //Цвет фона
//   glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //Очистка буфера цвета и глубины
//   wglMakeCurrent (0, 0);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglDeleteContext(h_RC);
end;
 
end.