Консольное приложение.

(часть 1, пример 21).

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

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.

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