function CreateGlWindow(title: PAnsiChar; width, height, bits : Integer; FullScreenflag : Boolean) : Boolean; stdcall;
var
Pixelformat : GLuint;
dwExStyle : dword;
dwStyle : dword;
pfd : pixelformatdescriptor;
dmScreenSettings : Devmode;
WindowRect : TRect;
begin
Result := False;
SetRect(WindowRect, 0, 0, width, height);
FullScreen := FullScreenflag;
if not DoRegister then
begin
MessageBox(0, 'Failed To Register The Window Class.', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
if FullScreen then
begin
ZeroMemory(@dmScreenSettings, sizeof(dmScreenSettings));
with dmScreensettings do
begin
dmSize := sizeof(dmScreenSettings);
dmPelsWidth := width;
dmPelsHeight := height;
dmBitsPerPel := bits;
dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
end;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN)) <> DISP_CHANGE_SUCCESSFUL then
begin
if MessageBox(0, 'This FullScreen Mode Is Not Supported. Use Windowed Mode Instead?'
,'NeHe GL', MB_YESNO or MB_ICONEXCLAMATION) = IDYES then
FullScreen := False
else
begin
MessageBox(0, 'Program Will Now Close.', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
end;
end;
if FullScreen then
begin
dwExStyle := WS_EX_APPWINDOW;
dwStyle := WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
Showcursor(False);
end
else
begin
dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
end;
AdjustWindowRectEx(WindowRect, dwStyle, False, dwExStyle);
H_wnd := CreateWindowExA(dwExStyle, 'OpenGl', PAnsiChar(Title), dwStyle,
0, 0, WindowRect.Right - WindowRect.Left, WindowRect.Bottom - WindowRect.Top,
0, 0, hinstance, NIL);
if h_Wnd = 0 then
begin
KillGlWindow;
MessageBox(0, 'Window creation error.', ' Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
FillChar(pfd, SizeOf(pfd), 0);
with pfd do
begin
nSize := SizeOf(PIXELFORMATDESCRIPTOR);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := bits;
cDepthBits := 16;
iLayerType := PFD_MAIN_PLANE;
end;
h_Dc := GetDC(h_Wnd);
if h_Dc = 0 then
begin
KillGLWindow;
MessageBox(0, 'Cant''t create a GL device context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
PixelFormat := ChoosePixelFormat(h_Dc, @pfd);
if PixelFormat = 0 then
begin
KillGLWindow;
MessageBox(0, 'Cant''t Find A Suitable PixelFormat.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
if not SetPixelFormat(h_Dc, PixelFormat, @pfd) then
begin
KillGLWindow;
MessageBox(0, 'Cant''t set PixelFormat.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
h_Rc := wglCreateContext(h_Dc);
if h_Rc = 0 then
begin
KillGLWindow;
MessageBox(0, 'Cant''t create a GL rendering context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
if not wglMakeCurrent(h_Dc, h_Rc) then
begin
KillGLWindow;
MessageBox(0, 'Cant''t activate the GL rendering context.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
ReSizeGLScene(width, height);
if not InitGl then
begin
KillGLWindow;
MessageBox(0, 'initialization failed.', 'Error', MB_OK or MB_ICONEXCLAMATION);
Exit;
end;
Result := True;
end;
procedure WinMain;
var
msg : TMsg;
done : Boolean;
begin
done := False;
if MessageBox(0, 'Would You Like To Run In FullScreen Mode?', 'Start FullScreen',
MB_YESNO or MB_ICONQUESTION) = IDNO then
FullScreen := False
else
FullScreen := True;
if not CreateGLWindow('NeHe''s OpenGL Framework', 640, 480, 16, FullScreen) then
Exit;
while not done do
begin
if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
begin
if msg.message = WM_QUIT then
done := True
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
begin
if (active and not DrawGLScene) or keys[VK_ESCAPE] then
done := True
else
SwapBuffers(h_Dc);
if keys[VK_F1] then
begin
Keys[VK_F1] := False;
KillGLWindow;
FullScreen := not FullScreen;
if not CreateGLWindow('NeHe''s OpenGL Framework', 640, 480, 16, fullscreen) then
Exit;
end;
end;
end;
killGLwindow;
end;
begin
WinMain;
end.