GLcoding.narod.ру

Инициализация OpenGL для Delphi

В этой статье мы проинициализируем (кривое слово неправда ли :) ) для дальнейшего использования, но сначала несколько вопросов которые возникаю у начинающих изучать OpenGL.

Размер программ написанных в Delpli

В Дельфи 6 шаблон нечего неделающего приложения весит ~330 кб... много, а если наша программа будет содержать несколько тысяч строк кода, что тогда? А тогда программист имеющий опыт перейдет на WinAPI.

Как программировать с использованием WinAPI ?

Запускаем Дельфи, жмем File >> New >> Application, закрываем форму и Редактор Кода, жмем Project >> View Source. Удаляем все что там есть и пишем новый код:

program Project1;

uses Windows;

{$R *.res}

begin

end.

Компилируем ... ~9 кб - здорово!!!

Ну ладно, приступим к OpenGL

program OpenGL;
uses
  Windows, Messages, OpenGL;
const
  WND_TITLE    = 'Game';

var
  h_Wnd       : HWND;
  h_DC        : HDC;
  h_RC        : HGLRC;
  keys        : Array[0..255] of Boolean;

В этой части кода объявляются библиотеки (в том числе и OpenGL), констаты, переменные.

procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;

function IntToStr(Num : Integer) : String;
begin
  Str(Num, result);
end;

procedure glDraw();
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glTranslatef(0, 0, -6.0);
end;

Процедура прорисовки - glDraw(); в процессе нашего обучения мы будем пользоваться ей чаще всего.

procedure glInit();
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Цвет фона
glShadeModel(GL_SMOOTH);	  	
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LESS);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
end;

В этой части кода устанавливается цвет фона, отоброжение модели.

procedure glResizeWnd(Width, Height : Integer);
begin
  if (Height = 0) then 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_CREATE:
      begin
      end;
    WM_CLOSE:
      begin
        PostQuitMessage(0);
        Result := 0
      end;
    WM_KEYDOWN:
      begin
        keys[wParam] := True;
        Result := 0;
      end;
    WM_KEYUP:
      begin
        keys[wParam] := False;
        Result := 0;
      end;
    WM_SIZE:
      begin
        glResizeWnd(LOWORD(lParam),HIWORD(lParam));
        Result := 0;
      end;
    else
      Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;

Функция отлавливания сообщений (нажатия клавиш, изменения размера окна и т.д ).

procedure glKillWnd(Fullscreen : Boolean);
begin
if Fullscreen then
  begin
	ChangeDisplaySettings(devmode(nil^), 0);
	ShowCursor(True);
  end;

if (not wglMakeCurrent(h_DC, 0)) then
	MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);

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

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;

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;

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

Это вам тоже пока не пригодится.

function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
wndClass             : TWndClass;
dwStyle                : DWORD;
dwExStyle            : DWORD;
dmScreenSettings : DEVMODE;
PixelFormat          : GLuint;
h_Instance            : HINST;
pfd                       : TPIXELFORMATDESCRIPTOR;

begin

h_Instance := GetModuleHandle(nil);
ZeroMemory(@wndClass, SizeOf(wndClass));

    with wndClass do
begin
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
lpfnWndProc := @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;

if Fullscreen then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmBitsPerPel := PixelDepth;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
end;

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 (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', WND_TITLE, dwStyle, 0, 0,
Width, Height, 0, 0, h_Instance, nil);
if h_Wnd = 0 then
begin
glKillWnd(Fullscreen);
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
glKillWnd(Fullscreen);
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);
nVersion                 := 1;
dwFlags                 := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType              := PFD_TYPE_RGBA;
cColorBits              := PixelDepth;
cRedBits                 := 0;
cRedShift                := 0;
cGreenBits              := 0;
cGreenShift             := 0;
cBlueBits                := 0;
cBlueShift               := 0;
cAlphaBits              := 0;
cAlphaShift             := 0;
cAccumBits            := 0;
cAccumRedBits      := 0;
cAccumGreenBits   := 0;
cAccumBlueBits     := 0;
cAccumAlphaBits   := 0;
cDepthBits              := 16;
cStencilBits             := 0;
cAuxBuffers            := 0;
iLayerType             := PFD_MAIN_PLANE;
bReserved              := 0;
dwLayerMask        := 0;
dwVisibleMask      := 0;
dwDamageMask    := 0;
end;

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);
Result := False;
Exit;
end;

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);
Result := False;
Exit;
end;

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);
Result := False;
Exit;
end;

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);
Result := False;
Exit;
end;

ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);

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, TRUE, 16) 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
glDraw();
SwapBuffers(h_DC);

if (keys[VK_ESCAPE]) then 
finished := True
else

end;
end;
glKillWnd(FALSE);
Result := msg.wParam;

end;

Самая главная часть кода, переход в полноэкранный режим.

begin
    WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.

Ну тут все понятно. Для самых ленивых в разделе DownLoads имеются исходники (только без коминнтариев). Если что-то вам не понятно, не расстраивайтесь - все прейдет с опытом.

Этот код я нашел на просторах Интернета сильно модифицировал и кое-что убрал.

На главную

При копировании материалов с сайта ссылка на него обязательна

Инициализация OpenGL для Delphi

Размер программ написанных в Delpli

Как программировать с использованием WinAPI ?

Ну ладно, приступим к OpenGL

Автор : Jonson