{**********************************************************************}
{* Иллюстрация к книге "OpenGL в проектах Delphi"                     *}
{* Краснов М.В. softgl@chat.ru                                        *}
{**********************************************************************}

program OpenGL_min;

uses
  Messages, Windows, OpenGL;

const
  AppName = 'OpenGL_Min';

Var
  Window : HWnd;
  Message : TMsg;
  WindowClass : TWndClass;
  dc : HDC;
  hrc : HGLRC;            // контекст воспроизведения OpenGL
  MyPaint : TPaintStruct;

// Процедура заполнения полей структуры PIXELFORMATDESCRIPTOR
procedure SetDCPixelFormat (hdc : HDC);
var
 pfd : TPixelFormatDescriptor; // данные формата пикселей
 nPixelFormat : Integer;
Begin
 With pfd do begin
  nSize := sizeof (TPixelFormatDescriptor); // размер структуры
  nVersion := 1;                            // номер версии
  dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; // множество битовых флагов, определяющих устройство и интерфейс
  iPixelType := PFD_TYPE_RGBA; // режим для изображения цветов
  cColorBits := 16;            // число битовых плоскостей в каждом буфере цвета
  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 (hdc, @pfd); // запрос системе - поддерживается ли выбранный формат пикселей
 SetPixelFormat (hdc, nPixelFormat, @pfd);      // устанавливаем формат пикселей в контексте устройства
End;

function WindowProc (Window : HWnd; Message, WParam : Word;
         LParam : LongInt) : LongInt; stdcall;
Begin
  WindowProc := 0;
  case Message of
  wm_Create:
       begin
       dc := GetDC (Window);
       SetDCPixelFormat (dc);        // установить формат пикселей
       hrc := wglCreateContext (dc); // создаёт контекст воспроизведения OpenGL
       ReleaseDC (Window, dc);
       end;
  wm_Paint:
       begin
       dc := BeginPaint (Window, MyPaint);
       wglMakeCurrent (dc, hrc);     // устанавливает текущий контекст воспроизведения

{************ ЗДЕСЬ РАСПОЛАГАЮТСЯ КОМАНДЫ РИСОВАНИЯ OpenGL **************}

       glClearColor (0.85, 0.75, 0.5, 1.0); // определение цвета фона
       glClear (GL_COLOR_BUFFER_BIT);       // установление цвета фона

{************************************************************************}

       wglMakeCurrent (dc, 0); // перед завершением работы необходимо,
                               // чтобы контекст никем не использовался

       EndPaint (Window, MyPaint);
       ReleaseDC (Window, dc);
       end;
  wm_Destroy :
       begin
       wglDeleteContext (hrc); // удаление контекста воспроизведения
       DeleteDC (dc);
       PostQuitMessage (0);
       Exit;
       end;

  end; // case
  WindowProc := DefWindowProc (Window, Message, WParam, LParam);
End;

Begin
  With WindowClass do
       begin
       Style := cs_HRedraw or cs_VRedraw;
       lpfnWndProc := @WindowProc;
       cbClsExtra := 0;
       cbWndExtra := 0;
       hInstance := 0;
       hCursor := LoadCursor (0, idc_Arrow);
       lpszClassName := AppName;
       end;
  RegisterClass (WindowClass);
  Window := CreateWindow (AppName, AppName,
       ws_OverLappedWindow or ws_ClipChildren
          or ws_ClipSiBlings, // обязательно для OpenGL
       cw_UseDefault, cw_UseDefault,
       cw_UseDefault, cw_UseDefault,
       HWND_DESKTOP, 0, HInstance, nil);
       ShowWindow (Window, CmdShow);
       UpdateWindow (Window);
  While GetMessage (Message, 0, 0, 0) do begin
       TranslateMessage (Message);
       DispatchMessage (Message);
  end;
  Halt (Message.wParam);
end.