Code:
unit xeEngine_window_win;
{$I ..\bindings\xeEngine_include.inc}
interface
type
TOnWindowUpdate = procedure of object;
function Window_Create(Title: PWideChar; Width,Height: Word; Fullscreen: Boolean): Boolean; cdecl;
function Window_Update(OnWindowUpdate: TOnWindowUpdate): Boolean; cdecl;
function Window_Close: Boolean; cdecl;
implementation
uses
xeEngine_main,
Windows,
Messages,
{$ifdef fpc}
gl,
glu
{$else}
OpenGL
{$endif}
;
const
cClassName = 'xeOpenGL';
var
WindowInfo: record
h_Rc : HGLRC;
h_Dc : HDC;
h_Wnd : HWND;
h_Instance : hinst;
keys : array [0..255] of BOOL;
Active : bool;
FullScreen : bool;
Width,Height : GLsizei;
end;
procedure ReSizeGLScene(Width,Height: GLsizei);
begin
if (Height=0) then Height := 1;
WindowInfo.Width := Width;
WindowInfo.Height := Height;
glViewport(0, 0, WindowInfo.Width, WindowInfo.Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(45.0,WindowInfo.Width/WindowInfo.Height,0.1,100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
function InitGL: bool;
begin
glShadeModel(GL_SMOOTH);
glClearColor(0.0, 0.0, 0.0, 0.5);
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LEQUAL);
glHint(GL_PERSPECTIVE_CORRECTION_HINT,GL_NICEST);
Result := True;
end;
function DrawGLScene: bool;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;
glTranslatef(-1.5,0.0,-6.0);
glBegin(GL_TRIANGLES);
glVertex3f( 0.0, 1.0, 0.0);
glVertex3f(-1.0,-1.0, 0.0);
glVertex3f( 1.0,-1.0, 0.0);
glEnd;
glTranslatef(3,0.0,0.0);
glBegin(GL_QUADS);
glVertex3f(-1.0, 1.0, 0.0);
glVertex3f( 1.0, 1.0, 0.0);
glVertex3f( 1.0,-1.0, 0.0);
glVertex3f(-1.0,-1.0, 0.0);
glEnd;
Result := True;
end;
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
WindowInfo.Active := true
else
WindowInfo.Active := false;
Result := 0;
end;
WM_CLOSE: Begin
PostQuitMessage(0);
Result := 0
end;
WM_KEYDOWN: begin
WindowInfo.keys[wParam] := TRUE;
Result := 0;
end;
WM_KEYUP: begin
WindowInfo.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;
begin
if WindowInfo.FullScreen then
begin
ChangeDisplaySettings(devmode(nil^),0);
showcursor(true);
end;
if WindowInfo.h_rc<> 0 then
begin
if (not wglMakeCurrent(WindowInfo.h_Dc,0)) then
MessageBox(0,'Release of DC and RC failed.',' Shutdown Error',MB_OK or MB_ICONERROR);
if (not wglDeleteContext(WindowInfo.h_Rc)) then
begin
MessageBox(0,'Release of Rendering Context failed.',' Shutdown Error',MB_OK or MB_ICONERROR);
WindowInfo.h_Rc:=0;
end;
end;
if (WindowInfo.h_Dc = 1) and (releaseDC(WindowInfo.h_Wnd,WindowInfo.h_Dc) <> 0) then
begin
MessageBox(0,'Release of Device Context failed.',' Shutdown Error',MB_OK or MB_ICONERROR);
WindowInfo.h_Dc:=0;
end;
if (WindowInfo.h_Wnd <> 0) and (not destroywindow(WindowInfo.h_Wnd))then
begin
MessageBox(0,'Could not release hWnd.',' Shutdown Error',MB_OK or MB_ICONERROR);
WindowInfo.h_Wnd:=0;
end;
if (not UnregisterClass(PChar(cClassName),WindowInfo.h_Instance)) then
begin
MessageBox(0,'Could Not Unregister Class.','SHUTDOWN ERROR',MB_OK or MB_ICONINFORMATION);
end;
end;
function GetDesktopBitsPerPixel: Integer;
var
DesktopDC: HDC;
begin
DesktopDC := GetDC(0);
try
Result := GetDeviceCaps(DesktopDC, BITSPIXEL) * GetDeviceCaps(DesktopDC, PLANES);
finally
ReleaseDC(0, DesktopDC);
end;
end;
function CreateGlWindow(title: PChar; width,height: integer; FullScreenflag: bool): boolean;
var
Pixelformat : GLuint;
wc : TWndclass;
dwExStyle : dword;
dwStyle : dword;
pfd : pixelformatdescriptor;
dmScreenSettings : Devmode;
WindowRect : TRect;
bits : Integer;
LastErrorStr : String;
begin
bits := GetDesktopBitsPerPixel;
WindowInfo.Active := True;
WindowRect.Left := 0;
WindowRect.Top := 0;
WindowRect.Right := width;
WindowRect.Bottom := height;
WindowInfo.h_instance := GetModuleHandle(nil);
WindowInfo.FullScreen := FullScreenflag;
WindowInfo.Width := width;
WindowInfo.Height := height;
wc.style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WindowInfo.h_Instance;
wc.hIcon := LoadIcon(0,IDI_WINLOGO);
wc.hCursor := LoadCursor(0,IDC_ARROW);
wc.hbrBackground := 0;
wc.lpszMenuName := nil;
wc.lpszClassName := PChar(cClassName);
if RegisterClass(wc) = 0 then
begin
Str(WindowInfo.h_instance,LastErrorStr);
MessageBox(0,PChar('Failed To Register The Window Class: Error '+LastErrorStr),'Error',MB_OK or MB_ICONERROR);
Result := false;
exit;
end;
if WindowInfo.FullScreen then
begin
ZeroMemory( @dmScreenSettings, sizeof(dmScreenSettings) );
dmScreensettings.dmSize := sizeof(dmScreenSettings);
dmScreensettings.dmPelsWidth := width;
dmScreensettings.dmPelsHeight := height;
dmScreensettings.dmBitsPerPel := bits;
dmScreensettings.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN)) <> DISP_CHANGE_SUCCESSFUL then
begin
if MessageBox(0,'This FullScreen Mode Is Not Supported. Use Windowed Mode Instead?'
,'xeEngine',MB_YESNO or MB_ICONEXCLAMATION) = IDYES then
WindowInfo.FullScreen := false
else
begin
MessageBox(0,'Program Will Now Close.','Error',MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
end;
end;
if WindowInfo.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);
WindowInfo.H_wnd := CreateWindowEx(dwExStyle,
PChar(cClassName),
PChar(Title),
dwStyle,
0,0,
WindowRect.Right-WindowRect.Left,
WindowRect.Bottom-WindowRect.Top,
0,
0,
WindowInfo.h_instance,
nil);
if WindowInfo.h_Wnd = 0 then
begin
Str(GetLastError,LastErrorStr);
MessageBox(0,PChar('CreateWindowEx error: '+LastErrorStr),'Error',MB_OK or MB_ICONEXCLAMATION);
KillGlWindow;
Result := False;
Exit;
end;
pfd.nSize := SizeOf( PIXELFORMATDESCRIPTOR );
pfd.nVersion := 1;
pfd.dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := bits;
pfd.cRedBits := 0;
pfd.cRedShift := 0;
pfd.cGreenBits := 0;
pfd.cBlueBits := 0;
pfd.cBlueShift := 0;
pfd.cAlphaBits := 0;
pfd.cAlphaShift := 0;
pfd.cAccumBits := 0;
pfd.cAccumRedBits := 0;
pfd.cAccumGreenBits := 0;
pfd.cAccumBlueBits := 0;
pfd.cAccumAlphaBits := 0;
pfd.cDepthBits := 16;
pfd.cStencilBits := 0;
pfd.cAuxBuffers := 0;
pfd.iLayerType := PFD_MAIN_PLANE;
pfd.bReserved := 0;
pfd.dwLayerMask := 0;
pfd.dwVisibleMask := 0;
pfd.dwDamageMask := 0;
WindowInfo.h_Dc := GetDC(WindowInfo.h_Wnd);
if WindowInfo.h_Dc = 0 then
begin
KillGLWindow;
MessageBox(0,'Cant''t create a GL device context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false;
exit;
end;
PixelFormat := ChoosePixelFormat(WindowInfo.h_Dc, @pfd);
if (PixelFormat = 0) then
begin
KillGLWindow;
MessageBox(0,'Cant''t Find A Suitable PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false;
exit;
end;
if (not SetPixelFormat(WindowInfo.h_Dc,PixelFormat,@pfd)) then
begin
KillGLWindow;
MessageBox(0,'Cant''t set PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
Exit;
end;
WindowInfo.h_Rc := wglCreateContext(WindowInfo.h_Dc);
if WindowInfo.h_Rc = 0 then
begin
KillGLWindow;
MessageBox(0,'Cant''t create a GL rendering context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
Exit;
end;
if not wglMakeCurrent(WindowInfo.h_Dc, WindowInfo.h_Rc) then
begin
KillGLWindow;
MessageBox(0,'Cant''t activate the GL rendering context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
Exit;
end;
ShowWindow(WindowInfo.h_Wnd,SW_SHOW);
SetForegroundWindow(WindowInfo.h_Wnd);
SetFocus(WindowInfo.h_Wnd);
ReSizeGLScene(width,height);
if not InitGL then
begin
KillGLWindow;
MessageBox(0,'initialization failed.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
Exit;
end;
Result := true;
end;
function Window_Create(Title: PWideChar; Width,Height: Word; Fullscreen: Boolean): Boolean;
begin
if not CreateGLWindow(PChar(Title),Width,Height,FullScreen) then
begin
Result := False;
Exit;
end;
Result := True;
end;
function Window_Update(OnWindowUpdate: TOnWindowUpdate): Boolean;
var
msg: TMsg;
begin
Result := True;
if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
begin
if msg.message = WM_QUIT then
Result := False
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
begin
if (WindowInfo.Active and not(DrawGLScene) or WindowInfo.keys[VK_ESCAPE]) then
Result := False
else
SwapBuffers(WindowInfo.h_Dc);
end;
if not Result and Assigned(OnWindowUpdate) then OnWindowUpdate;
end;
function Window_Close: Boolean;
begin
Result := True;
end;
end.
cheers,
Bookmarks