Основы программирования

program water2;
 
uses
  Windows,
  Messages,
  OpenGL,
  BMP;
 
const
  WND_TITLE = '))))';
  FPS_TIMER = 1;                     // Таймер для вычисления FPS
  RAIN_TIMER = 2;
 
  GridSize = 63;
 
type TGLCoord = Record
       X, Y, Z : glFloat;
     end;
var
  h_Wnd  : HWND;                     // Глобальный маркер окна
  h_DC   : HDC;                      // Глобальный контекст окна
  h_RC   : HGLRC;                    // OpenGL рендеринг
  keys : Array[0..255] of Boolean;   // Ждет нажатия клавиши
  ElapsedTime : Integer;             // Время между кадрами
 
  // Textures
  WaterTexture : glUint;
 
  // Пользовательские переменные
  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;
 
 
 
 
{$R *.RES}
 
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
 
{------------------------------------------------------------------}
{ Функция для преобразования int  в строка. (No sysutils = smaller EXE)  }
{------------------------------------------------------------------}
function IntToStr(Num : Integer) : String;  // using SysUtils increase file size by 100K
begin
  Str(Num, result);
end;
 
 
procedure CreateRainDrop;
begin
  Velocity[random(GridSize-3)+2, random(GridSize-3)+2] :=1060;
end;
 
 
procedure DrawWater;
var I, J : Integer;
    VectLength : glFloat;
begin
  // Вычисление новой скорости
  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
 
  // Вычисление новой позиции
  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;
 
  // Вычисление новых координат
  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;
 
  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;
 
  // Прорисовка Водной текстуры
  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]);
        glVertex3fv(@Vertex[I, J+1]);
        glNormal3fv(@Normals[I, J]);
        glVertex3fv(@Vertex[I, J]);
      end;
    glEnd;
  end;
end;
 
 
 
{------------------------------------------------------------------}
{  Функция для выводы фактической сцены                      }
{------------------------------------------------------------------}
procedure glDraw();
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);    // Очистка экрана и буфера обмена
  glLoadIdentity();                                      
 
  glTranslatef(0.0,0.2,-4.5);
 
  glRotatef(90, 1, 0, 0);
  glRotatef(0, 0, 1, 0);
 
 
  glColor3f(0.85, 1, 0.85);
  DrawWater;
end;
 
 
{------------------------------------------------------------------}
{  Инициализация OpenGL                            }
{------------------------------------------------------------------}
procedure glInit();
var I, J : Integer;
begin
  glClearColor(0.0, 0.0, 0.0, 0.0); 	   // Черный фон
  glShadeModel(GL_SMOOTH);               
  glClearDepth(1.0);                       
  glEnable(GL_DEPTH_TEST);                 // Установка буфера
  glDepthFunc(GL_LESS);		          
  glBlendFunc(GL_SRC_COLOR, GL_ONE);
 
  glEnable(GL_TEXTURE_2D);               // Допустимые наложения текстур
  LoadTexture('reflection.bmp', WaterTexture);    // Загрузка текстур
 
  // допустимые отображения
  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;
 
  // Инициализация таймера дождя
  RainInterval :=1000;
  SetTimer(h_Wnd, RAIN_TIMER, RainInterval, nil);
 
  Randomize;
 
end;
 
 
{------------------------------------------------------------------}
{  Окно,размера                           }
{------------------------------------------------------------------}
procedure glResizeWnd(Width, Height : Integer);
begin
  if (Height = 0) then                // предотвращение деления на 0
    Height := 1;
  glViewport(0, 0, Width, Height);    // Установка области просмотра
  glMatrixMode(GL_PROJECTION);        // Изменения матричного режима
  glLoadIdentity();                   // Сброс просмотра
  gluPerspective(45.0, Width/Height, 1.0, 100.0);  
 
  glMatrixMode(GL_MODELVIEW);         // Возврат к образцовой матрицк
  glLoadIdentity();                   // Сброс просмотра
end;
 
 
 
{------------------------------------------------------------------}
{  ответ приложения на полученные сообщения
{------------------------------------------------------------------}
function WndProc(hWnd: HWND; Msg: UINT;  wParam: WPARAM;  lParam: LPARAM): LRESULT; stdcall;
begin
  case (Msg) of
             //установка нажатияклавиши
    WM_KEYDOWN:      
      begin
        keys[wParam] := True;
        Result := 0;
      end;
 
    WM_TIMER :                    
      begin
        if wParam = FPS_TIMER then
        begin
 
          Result := 0;
        end
        else if wParam = RAIN_TIMER then
        begin
          CreateRainDrop;
          Result :=0;
        end;
      end;
    else
      Result := DefWindowProc(hWnd, Msg, wParam, lParam);    // Заданный по умолчанию результат если ничего не произошло
  end;
end;
 
 
{--------------------------------------------------------------------}
{  Создает окно
{--------------------------------------------------------------------}
function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
  wndClass : TWndClass;         // Window class
  dwStyle : DWORD;              // Window styles
  dwExStyle : DWORD;            // Extended window styles
  dmScreenSettings : DEVMODE;   // Screen settings (fullscreen, etc...)
  PixelFormat : GLuint;         // Settings for the OpenGL rendering
  h_Instance : HINST;           // Current instance
  pfd : TPIXELFORMATDESCRIPTOR;  // Settings for the OpenGL window
begin
  h_Instance := GetModuleHandle(nil);       //Grab An Instance For Our Window
  ZeroMemory(@wndClass, SizeOf(wndClass));  // Clear the window class structure
 
  with wndClass do                    // Set up the window class
  begin
    style         := CS_HREDRAW or    // Redraws entire window if length changes
                     CS_VREDRAW or    // Redraws entire window if height changes
                     CS_OWNDC;        // Unique device context for the window
    lpfnWndProc   := @WndProc;        // Set the window procedure to our func WndProc
    hInstance     := h_Instance;
    hCursor       := LoadCursor(0, IDC_ARROW);
    lpszClassName := 'OpenGL';
  end;
 
  if (RegisterClass(wndClass) = 0) then  
  begin
    MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit
  end;
 
 
  // попытка создания фактического окна
  h_Wnd := CreateWindowEx(dwExStyle,      // Extended window styles
                          'OpenGL',       // Class name
                          WND_TITLE,      // Window title (caption)
                          dwStyle,        // Window styles
                          0, 0,           // Window position
                          Width, Height,  // Size of window
                          0,              // No parent window
                          0,              // No menu
                          h_Instance,     // Instance
                          nil);           // Pass nothing to WM_CREATE
  if h_Wnd = 0 then
  begin
     MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
 
  // попытка получить информацию устройства
  h_DC := GetDC(h_Wnd);
  if (h_DC = 0) then
  begin
 
    MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
 
  // Параметры настройки окон 
  with pfd do
  begin
    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
    nVersion        := 1;                    // The version of this data structure
    dwFlags         := PFD_DRAW_TO_WINDOW    // Buffer supports drawing to window
                       or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
                       or PFD_DOUBLEBUFFER;  // Supports double buffering
    iPixelType      := PFD_TYPE_RGBA;        // RGBA color format
    cColorBits      := PixelDepth;           // OpenGL color depth
    cRedBits        := 0;                    // Number of red bitplanes
    cRedShift       := 0;                    // Shift count for red bitplanes
    cGreenBits      := 0;                    // Number of green bitplanes
    cGreenShift     := 0;                    // Shift count for green bitplanes
    cBlueBits       := 0;                    // Number of blue bitplanes
    cBlueShift      := 0;                    // Shift count for blue bitplanes
    cAlphaBits      := 0;                    // Not supported
    cAlphaShift     := 0;                    // Not supported
    cAccumBits      := 0;                    // No accumulation buffer
    cAccumRedBits   := 0;                    // Number of red bits in a-buffer
    cAccumGreenBits := 0;                    // Number of green bits in a-buffer
    cAccumBlueBits  := 0;                    // Number of blue bits in a-buffer
    cAccumAlphaBits := 0;                    // Number of alpha bits in a-buffer
    cDepthBits      := 16;                   // Specifies the depth of the depth buffer
    cStencilBits    := 0;                    // Turn off stencil buffer
    cAuxBuffers     := 0;                    // Not supported
    iLayerType      := PFD_MAIN_PLANE;       // Ignored
    bReserved       := 0;                    // Number of overlay and underlay planes
    dwLayerMask     := 0;                    // Ignored
    dwVisibleMask   := 0;                    // Transparent color of underlay plane
    dwDamageMask    := 0;                     // Ignored
  end;
 
 
 
  PixelFormat := ChoosePixelFormat(h_DC, @pfd);
  if (PixelFormat = 0) then
  begin
 
    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
 
  // Устанавливает формат пикселя
  if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
  begin
 
    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;
 
  // Создает контекст рендеринга
  h_RC := wglCreateContext(h_DC);
  if (not wglMakeCurrent(h_DC, h_RC)) then
  begin
  end;
 
  ShowWindow(h_Wnd, SW_SHOW);
  glResizeWnd(Width, Height);
  glInit();
 
  Result := True;
end;
 
 
{--------------------------------------------------------------------}
{  Основной цикл приложения                      }
{--------------------------------------------------------------------}
function WinMain(hInstance : HINST; hPrevInstance : HINST;
                 lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
  msg : TMsg;
  finished : Boolean;
  DemoStart, LastTime : DWord;
begin
  finished := False;
 
  // прикладная инициализация
  if not glCreateWnd(800, 600, FALSE, 32) then
  begin
    Result := 0;
    Exit;
  end;
 
  DemoStart := GetTickCount();            
  // Îñíîâíîé öèêë ñîîáùåíèÿ:
  while not finished do
  begin
    if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then // проверка есть ли ошибки
    begin
      if (msg.message = WM_QUIT) then    
        finished := True
      else
      begin                              
  	TranslateMessage(msg);
        DispatchMessage(msg);
      end;
    end
    else
    begin
 
 
      LastTime :=ElapsedTime;
      ElapsedTime :=GetTickCount() - DemoStart;     // вычисление времени
      ElapsedTime :=(LastTime + ElapsedTime) DIV 2; // для более гладкого движения
 
      glDraw();                           // Прорисовываем сцену
      SwapBuffers(h_DC);                  // Выводим на дсплей
 
      if (keys[VK_ESCAPE]) then           // ÅПринажатии  ESC выходим их программы
        finished := True
 
 
    end;
  end;
 
  Result := msg.wParam;
end;
 
begin
  WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.

unit BMP;
 
interface
 
uses
  Windows, OpenGL;
 
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
 
implementation
 
 
 
{------------------------------------------------------------------}
{ Битовый массив конвертации  BGR в RGB                              }
{------------------------------------------------------------------}
procedure SwapRGB(data : Pointer; Size : Integer);
asm
  mov ebx, eax
  mov ecx, size
 
@@loop :
  mov al,[ebx+0]
  mov [ebx+2],al
  mov [ebx+0],ah
  add ebx,3
  dec ecx
  jnz @@loop
end;
 
 
{------------------------------------------------------------------}
{  Загрузка BMP файла                                                 }
{------------------------------------------------------------------}
procedure LoadBitmap(Filename: String; out Width: Cardinal; out Height: Cardinal; out pData: Pointer);
var
  FileHeader: TBITMAPFILEHEADER;
  InfoHeader: TBITMAPINFOHEADER;
  Palette: array of RGBQUAD;
  BitmapFile: THandle;
  BitmapLength: LongWord;
  PaletteLength: LongWord;
  ReadBytes: LongWord;
begin
  BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (BitmapFile = INVALID_HANDLE_VALUE) then begin
    MessageBox(0, PChar('Error opening "' + Filename), PChar('BMP Unit'), MB_OK);
    Exit;
  end;
 
  // Получение информации о заголовке
  ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
  ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);
 
  // Получение текстуры
  PaletteLength := InfoHeader.biClrUsed;
  SetLength(Palette, PaletteLength);
  ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
  if (ReadBytes <> PaletteLength) then begin
    MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
    Exit;
  end;
 
  Width := InfoHeader.biWidth;
  Height := InfoHeader.biHeight;
  BitmapLength := InfoHeader.biSizeImage;
  if BitmapLength = 0 then
    BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;
 
  // Получение фактических данных пикселя
  GetMem(pData, BitmapLength);
  ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
  if (ReadBytes <> BitmapLength) then begin
    MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
    Exit;
  end;
  CloseHandle(BitmapFile);
 
  // Битовый обмен  BGR и ине  RGB
  SwapRGB(pData, Width*Height);
end;
 
 
{------------------------------------------------------------------}
{  Загрузка структуры  BMP                                            }
{------------------------------------------------------------------}
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
var
  pData: Pointer;
  Width: LongWord;
  Height: LongWord;
begin
  pData :=nil;
  LoadBitmap(Filename, Width, Height, pData);
 
  if (Assigned(pData)) then
    Result := True
  else
  begin
    Result := False;
    MessageBox(0, PChar('Unable to load ' + filename), 'Loading Textures', MB_OK);
    Halt(1);
  end;
 
  gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 
end;
end.