Results 1 to 7 of 7

Thread: CreateWindowEx() returining 0!

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1

    CreateWindowEx() returining 0!

    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:
    lesson02.zip

    and made a stand-alone Win OS unit:
    xeEngine_window_win.zip

    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
    Code:
    function CreateGlWindow(title:Pchar; width,height,bits:integer;FullScreenflag:bool):boolean 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,dwExStyle); // 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;
    Last edited by paul_nicholls; 10-08-2011 at 03:47 AM. Reason: didn't mention DLL fact

  2. #2
    and my version:
    Code:
    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,dwExStyle);
    
      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:
    Code:
    {$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

  3. #3
    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:

    Code:
      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

  4. #4
    Is h_Instance the same as hinstance. Those should be the same. I guess you should use hinstance both places.
    Peregrinus, expectavi pedes meos in cymbalis
    Nullus norvegicorum sole urinat

  5. #5
    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:
    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,
    Paul
    Last edited by paul_nicholls; 10-08-2011 at 06:51 AM.

  6. #6
    LOL! somehow I seemed to have fixed it

    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
    Last edited by paul_nicholls; 10-08-2011 at 10:19 AM.

  7. #7
    Ok, I can now confirm that it works under XP too - Woo Hoo!!

    Now I can continue further

    cheers,
    Paul

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •