procedure TEngine.glKillWnd(Fullscreen : Boolean);
begin
 if Fullscreen then             // Change back to non fullscreen
 begin
   ChangeDisplaySettings(devmode(nil^), 0);
   ShowCursor(True);
 end;

 // Makes current rendering context not current, and releases the device
 // context that is used by the rendering context.
 if (not wglMakeCurrent(h_DC, 0)) then
   MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);

 // Attempts to delete the rendering context
 if (not wglDeleteContext(h_rc)) then
 begin
   MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
   h_RC:= 0;
 end;

 // Attemps to release the device context
 if ((h_DC > 0) and (ReleaseDC(h_Wnd, h_DC) = 0)) then
 begin
   MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
   h_DC := 0;
 end;

 // Attempts to destroy the window
 if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
 begin
   MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
   h_Wnd := 0;
 end;

 // Attempts to unregister the window class
 if (not UnRegisterClass(ENGINE_NAME, hInstance)) then
 begin
   MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
   hInstance := 0;
 end;
end;

////////////////////////////////////////////////////////////////////////////////
///                         Public unit function
////////////////////////////////////////////////////////////////////////////////

procedure TEngine.InitEngine(name: PAnsiChar; width: Integer; height: Integer; bpp: Integer; FullScreen: Boolean = False);
var
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(@h_wc, SizeOf(h_wC));  // Clear the window class structure

 with h_wc 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 := ENGINE_NAME;
 end;
RegisterClassEX(h_wc);

 eFullScreen :=  FullScreen;

 // Change to fullscreen if so desired
 if Fullscreen then
 begin
   ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
   with dmScreenSettings do begin              // Set parameters for the screen setting
     dmSize       := SizeOf(dmScreenSettings);
     dmPelsWidth  := Width;                    // Window width
     dmPelsHeight := Height;                   // Window height
     dmBitsPerPel := bpp;               // Window color depth
     dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
   end;

   // Try to change screen mode to fullscreen
   if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
   begin
     MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
     Fullscreen := False;
   end;
 end;

 // If we are still in fullscreen then
 if (Fullscreen) then
 begin
   dwStyle := WS_POPUP or                // Creates a popup window
              WS_CLIPCHILDREN            // Doesn't draw within child windows
              or WS_CLIPSIBLINGS;        // Doesn't draw within sibling windows
   dwExStyle := WS_EX_APPWINDOW;         // Top level window
   ShowCursor(False);                    // Turn of the cursor (gets in the way)
 end
 else
 begin
   dwStyle := WS_OVERLAPPEDWINDOW or     // Creates an overlapping window
              WS_CLIPCHILDREN or         // Doesn't draw within child windows
              WS_CLIPSIBLINGS;           // Doesn't draw within sibling windows
   dwExStyle := WS_EX_APPWINDOW or       // Top level window
                WS_EX_WINDOWEDGE;        // Border with a raised edge
 end;

 // Attempt to create the actual window
 h_Wnd := CreateWindowEx(dwExStyle,      // Extended window styles
                         ENGINE_NAME,       // Class name
                         NAME,      // Window title (caption)
                         dwStyle,        // Window styles
                         0, 0,           // Window position
                         Width, Height,  // Size of window
                         0,              // No parent window
                         0                          ,              // No menu
                         hInstance,     // Instance
                         nil);           // Pass nothing to WM_CREATE
 if h_Wnd = 0 then
 begin
   glKillWnd(Fullscreen);                // Undo all the settings we've changed
   MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Try to get a device context
 h_DC := GetDC(h_Wnd);
 if (h_DC = 0) then
 begin
   glKillWnd(Fullscreen);
   MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Settings for the OpenGL window
 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      := BPP;           // 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;

 // Attempts to find the pixel format supported by a device context that is the best match to a given pixel format specification.
 PixelFormat := ChoosePixelFormat(h_DC, @pfd);
 if (PixelFormat = 0) then
 begin
   glKillWnd(Fullscreen);
   MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Sets the specified device context's pixel format to the format specified by the PixelFormat.
 if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
 begin
   glKillWnd(Fullscreen);
   MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Create a OpenGL rendering context
 h_RC := wglCreateContext(h_DC);
 if (h_RC = 0) then
 begin
   glKillWnd(Fullscreen);
   MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Makes the specified OpenGL rendering context the calling thread's current rendering context
 if (not wglMakeCurrent(h_DC, h_RC)) then
 begin
   glKillWnd(Fullscreen);
   MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
   Exit;
 end;

 // Settings to ensure that the window is the topmost window
 ShowWindow(h_Wnd, SW_SHOW);
 SetForegroundWindow(h_Wnd);
 SetFocus(h_Wnd);

 // Ensure the OpenGL window is resized properly
 glResizeWnd(Width, Height);
 glInit(); // Initialise any OpenGL States and variables
end;

procedure TEngine.Loop;
begin

 while GetMessage(h_msg, 0,0,0) do

     begin                               // Else translate and dispatch the message to this window
      TranslateMessage(h_msg);
       DispatchMessage(h_msg);
     end;

end;

procedure TEngine.Quit;
begin
 eFinished := true;
end;

destructor TEngine.Destroy;
begin
  glKillWnd(eFullscreen);
end;

end.

program game;

uses
 Windows,
 OpenGL,
 ENGINE in 'ENGINE.pas',
 GAME_ENGINE in 'GAME_ENGINE.pas',
 UTILITS in 'UTILITS.pas';

begin
 EngineInit;
 engine.InitEngine('name',1024,768,32,false);
 engine.Loop;
end.

program Example14;

uses
 Windows,
 Messages,
 OpenGL;

const
 APP_NAME = 'Example14'; // Название приложения

 mat_specular : array [0..3] of GLfloat = ( 1.0, 1.0, 1.0, 1.0 );   // Интенсивность зеркального света
 mat_shininess : GLfloat = 100.0;                                    // Яркость света
 light_position : array [0..3] of GLfloat = ( 0.0, 0.0, 1.0, 0.0 ); // Позиция света
 white_light : array [0..3] of GLfloat = ( 1.0, 0.9, 0.8, 0.0 );    // Цвет света
 light_ambient: array [0..3] of GLfloat = ( 0.5, 0.0, 0.8, 0.0 );    // Цвет фона

 fog_color: array [0..3] of GLfloat = ( 0.9, 0.9, 0.8, 0.0 );    // Цвет тумана

var
 h_wnd: HWND;
 h_wc:  TWndClassEx;
 h_dc:  HDC;
 h_rc:  HGLRC;
 msg :  TMsg;

 keys: array[0..255] of Boolean;

 finished : Boolean;
 i: integer;
 fogMode : GLint;   // Режим тумана

 rot: real;

 sph: gluQuadricObj;

 roll, pitch, heading, planex, planey, planez: GLFloat;
 distance, twist, elevation, azimuth: GLfloat;

 // UPS
   ups_time_old: integer;
   ups_time: integer;
 // FPS
   fps_time: Integer;
   fps_cur:  Integer;
   _FPS: integer;
   Time, Time_delta: integer;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Функция переводит Integer -> String                                          }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function IntToStr(n: integer):String;
begin
 STR(n, Result);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Камера пилота                                                                }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure PilotView(roll, pitch, heading, planex, planey, planez: GLFloat);
begin
 glRotatef(roll,0,0,1);
 glRotatef(roll,0,0,1);
 glRotatef(roll,0,0,1);
 glTranslatef(-planex, -planey, -planez);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Камера полярная                                                                }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure PolarView(distance, twist, elevation, azimuth: GLfloat);
begin
 glTranslatef(0,0,-distance);
 glRotatef(-twist, 0,0,1);
 glRotatef(-elevation, 1,0,0);
 glRotatef(azimuth, 0,0,1);
end;

procedure LST(x,y: integer);
begin
 fogMode := GL_EXP2;
 glFogi(GL_FOG_MODE, fogMode);
 glFogfv(GL_FOG_COLOR, @fog_color);
 glFogf(GL_FOG_DENSITY, 0.05);
 glHint(GL_FOG_HINT, GL_NICEST);
 glFogf(GL_FOG_START, -10.0);
 glFogf(GL_FOG_END, 10.0);
 gluSphere(sph, 1.0, 100, 100);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура рисования сцены                                                    }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Draw();
begin
 glLoadIdentity();                 // Очистить матрицу
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);     // Очистить буфер цвета

 glTranslatef(1.0,1.0,-15.0);
 glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0); // Установить ортогональную проекции
 glColor3f(1.0,0.0,0.0);

 gluLookAt(0,0,5,0,0,0,0,1,0);
     {
        Parameters:
             eyex, eyey, eyez
         The position of the eye point.
             centerx, centery, centerz
         The position of the reference point.
             upx, upy, upz
         The direction of the up vector.
     }

PilotView(roll, pitch, heading, planex, planey, planez);
PolarView(distance, twist, elevation, azimuth);

glEnable(GL_FOG);

glRotatef(rot,1,1,1);
glTranslatef(1,0,0);
glPushMatrix;
  glCallList(1);
glPopMatrix;

glRotatef(rot,1,0,0);
glTranslatef(1,0,0);
glPushMatrix;
  glCallList(1);
glPopMatrix;

glRotatef(rot,1,1,0);
glTranslatef(0,1,0);
glPushMatrix;
  glCallList(1);
glPopMatrix;

glRotatef(rot,1,1,0);
glTranslatef(-1,0,0);
glPushMatrix;
  glCallList(1);
glPopMatrix;

glFlush;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура обновления                                                         }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Update;
begin

rot := rot+0.1;

 //roll, pitch, heading, planex, planey, planez: GLFloat
 if keys[vk_left] then
 begin
   roll    := roll    + 0.001;
   pitch   := pitch   + 0.001;
   heading := heading + 0.001;
   planex  := planex  + 0.001;
   planey  := planey  + 0.001;
   planez  := planez  + 0.001;
 end;

 if keys[vk_right] then
 begin
   roll    := roll    - 0.001;
   pitch   := pitch   - 0.001;
   heading := heading - 0.001;
   planex  := planex  - 0.001;
   planey  := planey  - 0.001;
   planez  := planez  - 0.001;
 end;

 // distance, twist, elevation, azimuth
 if keys[49] then
 begin
   distance  := distance   + 0.01;
   twist     := twist      + 0.01;
   elevation := elevation  + 0.01;
   azimuth   := azimuth    + 0.01;
 end;

 if keys[50] then
 begin
   distance  := distance   - 0.01;
   twist     := twist      - 0.01;
   elevation := elevation  - 0.01;
   azimuth   := azimuth    - 0.01;
 end;

 if keys[51] then   fogMode := GL_EXP;
 if keys[52] then   fogMode := GL_EXP2;
 if keys[53] then   fogMode := GL_LINEAR;

 if keys[27] then finished := true; // Завершаем программу если нажата клавиша esc
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура инициализации                                                      }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Init;
begin
 glClearColor(1.0,1.0,1.0,1.0);   // Устанавливаем цвет очистки белый
 glShadeModel(GL_smooth);           // Позволяет применить цвет интерполированным

 // Создание новых объектов
 sph := gluNewQuadric();
 gluQuadricNormals(sph, GLU_SMOOTH);
 gluQuadricTexture(sph, GL_TRUE);

 glMaterialfv(GL_FRONT, GL_SPECULAR, @mat_specular);
 glMaterialfv(GL_FRONT, GL_SHININESS, @mat_shininess);

 glLightfv(GL_LIGHT0, GL_DIFFUSE, @white_light);
 glLightfv(GL_LIGHT0, GL_AMBIENT, @light_ambient);

 glLightf(GL_LIGHT0, GL_SPOT_CUTOFF , 100);
 glLightfv(GL_LIGHT0, GL_SPOT_DIRECTION, @light_position);

 glEnable(GL_LIGHTING);
 glEnable(GL_LIGHT0);
 glEnable(GL_DEPTH_TEST);

 glNewList(1,GL_COMPILE);
    LST(1,1);
 glEndList();

end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура уничтожения программы                                              }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure DestroyWnd(Fullscreen : Boolean);
begin
 if Fullscreen then
 begin
   ChangeDisplaySettings(devmode(nil^), 0);
   ShowCursor(True);
 end;
wglMakeCurrent(h_DC, 0);
wglDeleteContext(h_RC);
ReleaseDC(h_Wnd, h_DC);
DestroyWindow(h_Wnd);
UnRegisterClass('OpenGL', hInstance);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура отвечающая за измененние размеров окна                             }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Resize(Width, Height : Integer);
begin
 glViewport(0, 0, Width, Height);    // Установить порт просмотра OpenGL
 glMatrixMode(GL_PROJECTION);        // Установить проекционную матрицу
 glLoadIdentity();                   // Очистить матрицу
 gluPerspective(45.0, Width/Height, 1.0, 100.0);  // Установить перспективу
 glMatrixMode(GL_MODELVIEW);         // Установить матрицу отображения
 glLoadIdentity();                   // Очистить матрицу
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура перехода в полноекраный режим                                      }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure DoFullScreen(width,height,bits: integer);
var
 dm: DevMode;
 hr: HRESULT;
 DC: HDC;
begin
 FillChar(dm, SizeOF(dm), 0);         // Заполнить структуру dm нулями
 dm.dmSize := SizeOf(DevMode);        // Устанавливаем размер dm
 dm.dmFields:= DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
 dm.dmPelsWidth := width;             // Ширина окна
 dm.dmPelsHeight := height;           // Высота окна
 dm.dmBitsPerPel := bits;             // Глубина цвета
 dm.dmDisplayFrequency := 75;         // Частота обновления экрана
 hr := ChangeDisplaySettings(dm,CDS_FULLSCREEN); // включить полноекранный режим
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Главная процедура обработки сообщений                                        }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function WndProc(hwnd: HWND; msg: integer; wparam: WPARAM; lparam: LPARAM):LResult; stdcall;
begin
 case msg of
   WM_CREATE:  begin end;
   WM_DESTROY: begin PostQuitMessage(0); Result := 0; end;
   WM_SIZE:    begin Resize(LOWORD(lparam), HIWORD(lparam)); Result := 0; end;
   WM_KEYDOWN: begin keys[wparam] := true; result := 0;  end;
   WM_KEYUP:   begin keys[wparam] := false; result := 0;  end;
 else
   Result := DefWindowProc(hwnd, msg, wparam, lparam);
 end;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура создаёт окно и инициализирует OpenGL                               }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure CreateAPP(width, height: integer; FullScreen: Boolean = false);
var
 pfd: TPixelFormatDescriptor;
 nPixelFormat: Integer;
 dwStyle : DWORD;              // Window styles
 dwExStyle : DWORD;            // Extended window styles
begin
 // Заполнить структуру h_wc нулями
 FillChar(h_wc, SizeOf(h_wc), 0);
 // Установка основных параметров класса
 h_wc.cbSize := SizeOf(h_wc);
 h_wc.style  := CS_OWNDC or CS_VREDRAW or CS_HREDRAW;  // позволяет перерисовывывать окно
 h_wc.lpfnWndProc := @WndProc;                         // указатель на процедуру обработки сообщений
 h_wc.hInstance    := HInstance;                       // экземпляр приложения
 h_wc.lpszMenuName := nil;                             // отсутствие меню (nil)
 h_wc.hCursor      := LoadCursor(0, IDC_ARROW);        // устанавливаем стандартный курсор
//  h_wc.hbrBackground := COLOR_BTNFACE+1;                // цвет окна
 h_wc.lpszClassName := 'OpenGL';                       // имя класса
 // Регистрация класса окна в системе
 WINDOWS.RegisterClassEx(h_wc);
 // Создаётся окно
 if (Fullscreen) then
 begin
   dwStyle := WS_POPUP or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
   dwExStyle := WS_EX_APPWINDOW;
   ShowCursor(False);
 end
 else
 begin
   dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
   dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
 end;

 // Создать окно
 h_Wnd := CreateWindowEx(dwExStyle,'OpenGL',APP_NAME, dwStyle, 0, 0, Width, Height, 0, 0, hInstance, nil);
 h_dc := GetDC(h_wnd); // Получить контекст окна

 // Настройка формата пикселей
 with pfd do
 begin
   nSize := SizeOf(TPixelFormatDescriptor); // размер структуры
   nVersion := 1;                            // номер версии
   dwFlags := PFD_DOUBLEBUFFER or PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; // множество битовых флагов, определяющих устройство и интерфейс
   iPixelType := PFD_TYPE_RGBA; // режим для изображения цветов
   cColorBits := 32;            // число битовых плоскостей в каждом буфере цвета
   cRedBits := 0;               // число битовых плоскостей красного в каждом буфере RGBA
   cRedShift := 0;              // смещение от начала числа битовых плоскостей красного в каждом буфере RGBA
   cGreenBits := 0;             // число битовых плоскостей зелёного в каждом буфере RGBA
   cGreenShift := 0;            // смещение от начала числа битовых плоскостей зелёного в каждом буфере RGBA
   cBlueBits := 0;              // число битовых плоскостей синего в каждом буфере RGBA
   cBlueShift := 0;             // смещение от начала числа битовых плоскостей синего в каждом буфере RGBA
   cAlphaBits := 0;             // число битовых плоскостей альфа в каждом буфере RGBA
   cAlphaShift := 0;            // смещение от начала числа битовых плоскостей альфа в каждом буфере RGBA
   cAccumBits := 0;             // общее число битовых плоскостей в буфере аккумулятора
   cAccumRedBits := 0;          // число битовых плоскостей красного в буфере аккумулятора
   cAccumGreenBits := 0;        // число битовых плоскостей зелёного в буфере аккумулятора
   cAccumBlueBits := 0;         // число битовых плоскостей синего в буфере аккумулятора
   cAccumAlphaBits := 0;        // число битовых плоскостей альфа в буфере аккумулятора
   cDepthBits := 32;            // размер буфера глубины (ось z)
   cStencilBits := 0;           // размер буфера трафарета
   cAuxBuffers := 0;            // число вспомогательных буферов
   iLayerType := PFD_MAIN_PLANE;// тип плоскости
   bReserved := 0;              // число плоскостей переднего и заднего плана
   dwLayerMask := 0;            // игнорируется
   dwVisibleMask := 0;          // индекс или цвет прозрачности нижней плоскости
   dwDamageMask := 0;           // игнорируется
 end;

 nPixelFormat := ChoosePixelFormat( H_DC, @pfd ); // запрос системе - поддерживается ли выбранный формат пикселей
 SetPixelFormat( H_DC, nPixelFormat, @pfd );      // устанавливаем формат пикселей в контексте устройства

 h_rc := wglCreateContext(h_dc);
 wglMakeCurrent(h_dc, h_rc);

 // Установить полноекранный режим
 if FullScreen then DoFullScreen(width, height, 32);

 // Отображается окно
 ShowWindow(h_wnd, SW_SHOW);
 SetForegroundWindow(h_Wnd);
 SetFocus(h_Wnd);
 Resize(width,height);
 Init;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура получает системное время                                           }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function GetTime: integer;
var
 T: LARGE_INTEGER;
 F: LARGE_INTEGER;
begin
 // Сверхточный таймер
 QueryPerformanceFrequency(Int64(F));
 QueryPerformanceCounter(Int64(T));
 Result:= Trunc(1000 * T.QuadPart / F.QuadPart);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура сбрасывает значение таймера                                        }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure ResetTimer;
begin
 ups_time_old := GetTime;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Функция получает FPS                                                         }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
function FPS: integer;
begin
 Result := _FPS;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Главный цикл сообщений                                                       }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure Loop(UPS: Integer);
begin
 ups_time_old := GetTime - 1000 div UPS;
 ups_time := GetTime;
 fps_time := GetTime;

 while not finished do
 begin
   while PeekMessage(msg,0,0,0,PM_REMOVE) do
   begin
     if msg.message = WM_QUIT then finished := true else begin
       TranslateMessage(msg);
       DispatchMessage(msg);
     end;
   end;
   while GetTime - ups_time_old >= (1000 div ups) do
   begin
   Update;
   inc(ups_time_old, 1000 div ups);
   end;
   Draw;
   SwapBuffers(h_dc);
   if fps_time <= GetTime then
   begin
     fps_time := GetTime + 1000;
     _FPS := fps_cur;
     fps_cur := 0;
   end;
   inc(fps_cur);
   SetWindowText(h_Wnd, PChar(APP_NAME + '   [' + intToStr(_FPS) + ' FPS]'));
 end;
DestroyWND(false);
end;

begin
 CreateAPP(1024,768, true);
 Loop(500);
end.