PDA

View Full Version : CreateWindowEx() returining 0!



paul_nicholls
10-08-2011, 01:59 AM
Hi all,
I am trying to make a bare bones Windows unit that will create, update, and destroy an OpenGL window (Win OS) for me (I am using Delphi 2010 if this helps).

I took the basic code from the Lesson 2 NeHe OpenGL window code:
534

and made a stand-alone Win OS unit:
535

EDIT: I am using this unit inside a DLL to try and create a window...

Here are the two CreateGlWindow routines (original) and then mine:

Orginal

function CreateGlWindow(title:Pchar; width,height,bits:integer;FullScreenflag:bool):boo lean stdcall;
var
Pixelformat: GLuint; // Ukl?°d?° form?°t pixel??
wc:TWndclass; // Struktura Windows Class
dwExStyle:dword; // Rozš????en?? styl okna
dwStyle:dword; // Styl okna
pfd: pixelformatdescriptor; // Nastaven?? form?°tu pixel??
dmScreenSettings: Devmode; // M??d za????zen??
h_Instance:hinst; // Instance okna
WindowRect: TRect; // Obd?©ln??k okna
begin
WindowRect.Left := 0; // Nastav?? lev?? okraj na nulu
WindowRect.Top := 0; // Nastav?? horn?? okraj na nulu
WindowRect.Right := width; // Nastav?? prav?? okraj na zadanou hodnotu
WindowRect.Bottom := height; // Nastav?? spodn?? okraj na zadanou hodnotu
h_instance:=GetModuleHandle(nil); // Z??sk?° instanci okna
FullScreen:=FullScreenflag; // Nastav?? prom?¨nnou fullscreen na spr?°vnou hodnotu
with wc do
begin
style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC; // P??ekreslen?? p??i zm?¨n?¨ velikosti a vlastn?? DC
lpfnWndProc:=@WndProc; // Definuje proceduru okna
cbClsExtra:=0; // Ž?°dn?° extra data
cbWndExtra:=0; // Ž?°dn?° extra data
hInstance:=h_Instance; // Instance
hIcon:=LoadIcon(0,IDI_WINLOGO); // Standardn?? ikona
hCursor:=LoadCursor(0,IDC_ARROW); // Standardn?? kurzor myši
hbrBackground:=0; // Pozad?? nen?? nutn?©
lpszMenuName:=nil; // Nechceme menu
lpszClassName:='OpenGl'; // Jm?©no t????dy okna
end;
if RegisterClass(wc)=0 then // Registruje t????du okna
begin
MessageBox(0,'Failed To Register The Window Class.','Error',MB_OK or MB_ICONERROR);
Result:=false; // P??i chyb?¨ vr?°t?? false
exit;
end;
if FullScreen then // Budeme ve fullscreenu?
begin
ZeroMemory( @dmScreenSettings, sizeof(dmScreenSettings) ); // Vynulov?°n?? pam?¨ti
with dmScreensettings do
begin
dmSize := sizeof(dmScreenSettings); // Velikost struktury Devmode
dmPelsWidth := width; // Š????ka okna
dmPelsHeight := height; // V??ška okna
dmBitsPerPel := bits; // Barevn?° hloubka
dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
end;
// Pokus?? se použ??t pr?°v?¨ definovan?© nastaven??
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN))<>DISP_CHANGE_SUCCESSFUL THEN
Begin
// Nejde-li fullscreen, m??že uživatel spustit program v okn?¨ nebo ho opustit
if MessageBox(0,'This FullScreen Mode Is Not Supported. Use Windowed Mode Instead?'
,'NeHe GL',MB_YESNO or MB_ICONEXCLAMATION)= IDYES then
FullScreen:=false // B?¨h v okn?¨
else
begin
// Zobraz?? uživateli zpr?°vu, že program bude ukon?®en
MessageBox(0,'Program Will Now Close.','Error',MB_OK or MB_ICONERROR);
Result:=false; // Vr?°t?? FALSE
exit;
end;
end;
end;
if FullScreen then // Jsme st?°le ve fullscreenu?
begin
dwExStyle:=WS_EX_APPWINDOW; // Rozš????en?? styl okna
dwStyle:=WS_POPUP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; // Styl okna
Showcursor(false); // Skryje kurzor
end
else
begin
dwExStyle:=WS_EX_APPWINDOW or WS_EX_WINDOWEDGE; // Rozš????en?? styl okna
dwStyle:=WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; // Styl okna
end;
AdjustWindowRectEx(WindowRect,dwStyle,false,dwExSt yle); // P??izp??soben?? velikosti okna
// Vytvo??en?? okna
H_wnd:=CreateWindowEx(dwExStyle, // Rozš????en?? styl
'OpenGl', // Jm?©no t????dy
Title, // Titulek
dwStyle, // Definovan?? styl
0,0, // Pozice
WindowRect.Right-WindowRect.Left, // V??po?®et š????ky
WindowRect.Bottom-WindowRect.Top, // V??po?®et v??šky
0, // Ž?°dn?© rodi?®ovsk?© okno
0, // Bez menu
hinstance, // Instance
nil); // Nep??edat nic do WM_CREATE
if h_Wnd=0 then // Pokud se okno nepoda??ilo vytvo??it
begin
KillGlWindow(); // Zruš?? okno
MessageBox(0,'Window creation error.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Vr?°t?? chybu
exit;
end;
with pfd do // Ozn?°m??me Windows jak chceme vše nastavit
begin
nSize:= SizeOf( PIXELFORMATDESCRIPTOR ); // Velikost struktury
nVersion:= 1; // ?à??slo verze
dwFlags:= PFD_DRAW_TO_WINDOW // Podpora okna
or PFD_SUPPORT_OPENGL // Podpora OpenGL
or PFD_DOUBLEBUFFER; // Podpora Double Bufferingu
iPixelType:= PFD_TYPE_RGBA; // RGBA Format
cColorBits:= bits; // Zvol?? barevnou hloubku
cRedBits:= 0; // Bity barev ignorov?°ny
cRedShift:= 0;
cGreenBits:= 0;
cBlueBits:= 0;
cBlueShift:= 0;
cAlphaBits:= 0; // Ž?°dn?? alpha buffer
cAlphaShift:= 0; // Ignorov?°n Shift bit
cAccumBits:= 0; // Ž?°dn?? akumula?®n?? buffer
cAccumRedBits:= 0; // Akumula?®n?? bity ignorov?°ny
cAccumGreenBits:= 0;
cAccumBlueBits:= 0;
cAccumAlphaBits:= 0;
cDepthBits:= 16; // 16-bitov?? hloubkov?? buffer (Z-Buffer)
cStencilBits:= 0; // Ž?°dn?? Stencil Buffer
cAuxBuffers:= 0; // Ž?°dn?? Auxiliary Buffer
iLayerType:= PFD_MAIN_PLANE; // Hlavn?? vykreslovac?? vrstva
bReserved:= 0; // Rezervov?°no
dwLayerMask:= 0; // Maska vrstvy ignorov?°na
dwVisibleMask:= 0;
dwDamageMask:= 0;
end;
h_Dc := GetDC(h_Wnd); // Zkus?? p??ipojit kontext za????zen??
if h_Dc=0 then // Poda??ilo se p??ipojit kontext za????zen???
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'Cant''t create a GL device context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
PixelFormat := ChoosePixelFormat(h_Dc, @pfd); // Zkus?? naj??t Pixel Format
if (PixelFormat=0) then // Poda??ilo se naj??t Pixel Format?
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'Cant''t Find A Suitable PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
if (not SetPixelFormat(h_Dc,PixelFormat,@pfd)) then // Poda??ilo se nastavit Pixel Format?
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'Cant''t set PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
h_Rc := wglCreateContext(h_Dc); // Poda??ilo se vytvo??it Rendering Context?
if (h_Rc=0) then
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'Cant''t create a GL rendering context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
if (not wglMakeCurrent(h_Dc, h_Rc)) then // Poda??ilo se aktivovat Rendering Context?
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'Cant''t activate the GL rendering context.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
ShowWindow(h_Wnd,SW_SHOW); // Zobrazen?? okna
SetForegroundWindow(h_Wnd); // Do pop??ed??
SetFOcus(h_Wnd); // Zam?¨???? fokus
ReSizeGLScene(width,height); // Nastaven?? perspektivy OpenGL sc?©ny
if (not InitGl()) then // Inicializace okna
begin
KillGLWindow(); // Zav??e okno
MessageBox(0,'initialization failed.','Error',MB_OK or MB_ICONEXCLAMATION);
Result:=false; // Ukon?®?? program
exit;
end;
Result:=true; // Vše prob?¨hlo v po???°dku
end;

paul_nicholls
10-08-2011, 02:00 AM
and my version:

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;
h_Instance : hinst;
WindowRect : TRect;
bits : Integer;
begin
bits := GetDesktopBitsPerPixel;

WindowRect.Left := 0;
WindowRect.Top := 0;
WindowRect.Right := width;
WindowRect.Bottom := height;
h_instance := GetModuleHandle(nil);
FullScreen := FullScreenflag;

ViewPort.Width := width;
ViewPort.Height := height;

wc.style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
wc.lpfnWndProc := @WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := h_Instance;
wc.hIcon := LoadIcon(0,IDI_WINLOGO);
wc.hCursor := LoadCursor(0,IDC_ARROW);
wc.hbrBackground := 0;
wc.lpszMenuName := nil;
wc.lpszClassName := cClassName;

if RegisterClass(wc) = 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) );

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
FullScreen := false
else
begin
MessageBox(0,'Program Will Now Close.','Error',MB_OK or MB_ICONERROR);
Result := False;
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,dwExSt yle);

H_wnd := CreateWindowEx(dwExStyle,
cClassName,
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: h_Wnd = 0','Error',MB_OK or MB_ICONEXCLAMATION);
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;

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);
Result:=false;
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);
Result:=false;
exit;
end;

if (not SetPixelFormat(h_Dc,PixelFormat,@pfd)) then
begin
KillGLWindow;
MessageBox(0,'Cant''t set PixelFormat.','Error',MB_OK or MB_ICONEXCLAMATION);
Result := false;
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);
Result := false;
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);
Result := false;
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);
Result := false;
Exit;
end;

Result := true;
end;

In case it makes a difference, here is the include file that my window unit uses:

{$IFDEF VER130} // Delphi 5
{$DEFINE DELPHI5}
{$DEFINE DELPHI5_UP}
{$ENDIF}

{$IFDEF VER140} // Delphi 6
{$DEFINE DELPHI6}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$ENDIF}

{$IFDEF VER150} // Delphi 7
{$DEFINE DELPHI7}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$ENDIF}

{$IFDEF VER200} // RAD Studio 2009
{$DEFINE DELPHI12}
{$DEFINE DELPHI2009}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI2009_UP}
{$DEFINE UNIC}
{$ENDIF VER200}

{$IFDEF VER210} // RAD Studio 2010
{$DEFINE DELPHI14}
{$DEFINE DELPHI2010}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI2009_UP}
{$DEFINE DELPHI2010_UP}
{$DEFINE UNIC}
{$ENDIF VER210}

{$IFDEF VER220} // RAD Studio XE
{$DEFINE DELPHI14}
{$DEFINE DELPHI2010}
{$DEFINE DELPHIXE}
{$DEFINE DELPHI5_UP}
{$DEFINE DELPHI6_UP}
{$DEFINE DELPHI7_UP}
{$DEFINE DELPHI2009_UP}
{$DEFINE DELPHI2010_UP}
{$DEFINE DELPHIXE_UP}
{$DEFINE UNIC}
{$ENDIF VER220}

{$IFDEF DELPHI7_UP}
{$WARN SYMBOL_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNIT_PLATFORM OFF}
{$WARN UNIT_DEPRECATED OFF}
{$ENDIF}

{$ifdef fpc}
{$mode delphi}
{$endif}

{$MINENUMSIZE 4}
{$ALIGN ON}

{$ifdef win32}
{$ifndef windows}
{$define windows}
{$endif}
{$endif}

{$ifdef win64}
{$ifndef windows}
{$define windows}
{$endif}
{$endif}

{$H+}

Unfortunately when running the Window_Create() routine, the CreateWindowEx() function is returning 0 for the h_Wnd variable...

This has me stumped...the basic Delphi project works for me, but my converted version doesn't :(

Any ideas?

cheers,
Paul

paul_nicholls
10-08-2011, 03:49 AM
AAARRRGGGHHH!!!

I have discovered that if I run the code inside a DLL (forgot to mention this...D'OH!) then CreateWindowEx() returns 0, but if I run the same code outside the DLL as a plain unit like this:


if Window_Create('some title',800,600,False) then
begin
WriteLn('Press Space to Quit...');
while Window_Update(nil) do
begin

end;

Window_Close;
end;


Then it works...

Any idea if this is possible from inside a DLL?

This is kinda a show-stopper for me as I want to do all of this INSIDE a DLL :(

cheers,
Paul

JSoftware
10-08-2011, 06:40 AM
Is h_Instance the same as hinstance. Those should be the same. I guess you should use hinstance both places.

paul_nicholls
10-08-2011, 06:48 AM
I forgot to add that I was getting a 1407 error from GetLastError - this meant it couldn't find the window class when I was trying to use CreateWindowEx().

Anyway, I have now gotten it working in Delphi 2010, but not Lazarus :(

I got it working in Delphi since inside the DLL, I WAS using the built in hinstance variable in at least one place - this didn't seem to be valid inside a DLL, hence the issue.

Now after using GetModuleHandle() as the new instance value, it works in Delphi 2010.

But it still is not working in Lazarus - still comes up with the same error :(

I am having trouble debugging it to find out if the GetModuleHandle() is returning a valid value in Lazarus, but I suspect this is the case...

If I compile the DLL in Delphi then it works via Lazarus and Delphi, but if I compile the DLL using Lazarus, then it fails with the 1407 error using both Delphi and Lazarus...

here is the new 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_Ins tance)) 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,dwExSt yle);

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,FullScree n) 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,
Paul

paul_nicholls
10-08-2011, 10:13 AM
LOL! somehow I seemed to have fixed it :D

I made a very simple test program and test dll so I could post it here to see if people could help me find the issue, and it started working!!

I fixed up another issue with the title not working correctly in Lazarus, put it back to the original test program and updated windowing unit and it still works - both in Lazarus and Delphi 2010! yay!

EDIT: thinking about this further, it might be because I am now running it on Vista...perhaps it just wasn't running correctly under XP?
I don't know yet :(

I still might have to post the test program here so people can try it under XP and other PC's...

cheers,
Paul

paul_nicholls
10-08-2011, 10:43 PM
Ok, I can now confirm that it works under XP too - Woo Hoo!!

Now I can continue further ;)

cheers,
Paul