Så här vill jag att init ska se ut
unit Init;
interface
uses
Windows,
Messages,
OpenGL12;
type
TWM = ( wmAsk, wmFullscreen, wmWindowed );
var
h_RC : HGLRC;
h_DC : HDC;
h_Wnd : HWND;
Keys : array[0..255] of BOOL;
Active : Boolean;
FullScreen : Boolean;
WindowWidth : Integer;
WindowHeight : Integer;
PixelDepth : Integer;
WindowTitle : String;
procedure NewWindow(Title: String; Width, Height, Bits: Integer; WindowMode: TWM);
implementation
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if Msg = WM_SYSCOMMAND then
begin
case wParam of
SC_SCREENSAVE, SC_MONITORPOWER:
begin
result := 0;
exit;
end;
end;
end;
case Msg of
WM_ACTIVATE:
begin
if (Hiword(wParam) = 0) then
Active := true
else
Active := false;
Result := 0;
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
// ReSizeGLScene(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end
else
begin
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;
end;
end;
procedure KillGLWindow(Fullscreen:Boolean);
begin
CloseOpenGL;
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 > 1) 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 WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar; nCmdShow: integer): integer; stdcall;
var
Msg: TMsg;
Done: Boolean;
begin
Done := false;
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 keys[VK_ESCAPE] then
Done := true
else begin
// glDrawScene();
SwapBuffers(h_DC);
// ProcessKeys();
// Count FPS
// FPS := FPS + 1;
// if int(GetTickCount()) - LastTime > 1000 then
// begin
// SetWindowText(h_Wnd, PChar('FPS: ' + inttostr(FPS)));
// FPS := 0;
// LastTime := GetTickCount();
// end;
end;
end;
end;
KillGLwindow(FALSE);
Result := Msg.wParam;
end;
function CreateGLWindow(): 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 := WindowWidth;
dmPelsHeight := WindowHeight;
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',
PChar(WindowTitle),
dwStyle,
0, 0,
WindowWidth, WindowHeight,
0,
0,
h_Instance,
nil);
if h_Wnd = 0 then
begin
KillGLWindow(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
KillGLWindow(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
KillGLWindow(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
KillGLWindow(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
KillGLWindow(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
KillGLWindow(Fullscreen);
MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
InitOpenGL;
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
// glResizeWnd(Width, Height);
// glInit();
Result := True;
end;
procedure NewWindow(Title: String; Width, Height, Bits: Integer; WindowMode: TWM);
begin
case WindowMode of
wmAsk:
begin
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;
end;
wmFullscreen : Fullscreen := true;
wmWindowed : Fullscreen := false;
end;
if not CreateGLWindow() then
begin
Exit;
end;
Active := true;
WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end;
end.