Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

OpenGL Support Test

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin OpenGL Support Test

    Simple application to determine whether is OpenGL correctly installed,
    and if it is, how powerful is the platform it runs on.

    Attached archive contains both source code and EXE file.

    Code:
    '==============================================================================
    '
    '  OpenGL Support Test
    '  Petr Schreiber, 2009
    '
    '  Use at own risk
    '
    '==============================================================================
    
    #COMPILER PBWIN 9
    #COMPILE EXE
    #DIM ALL
    
    %USEMACROS = 1
    
    ' -- Using state-of-the-art headers from José Roca
    #INCLUDE "win32api.inc"
    #INCLUDE "opengl.inc"
                 
    %IDOK       = 1
    %lVendor    = 1000
    %lRenderer  = 1001
    %lExtensions= 1002
    %lVersion   = 1003
    
    %btnClose  = 1000
    %btnSave   = 1001
    
    %edtRenderer = 1002
    %edtVendor   = 1003
    %edtOpenGL   = 1004
    %listExtensions= 1005
    %listTypes   = 1006
    
    %lblOpenGLStatus = 1007
                     
    ' -- Global variables to hold important information
    GLOBAL Extensions() AS STRING, ExtensionTypes() AS STRING, Renderer, Vendor, OGLVersion AS STRING
    
    ' -- Entry point
    FUNCTION PBMAIN () AS LONG
    
      LOCAL hDlg    AS DWORD
    
      DIALOG NEW 0, "OpenGL Support Test",,, 300, 285, _
                                       %WS_POPUP OR %WS_VISIBLE OR _
                                       %WS_CLIPCHILDREN OR %WS_CAPTION OR _
                                       %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg
    
      ' -- Display the dialog
      DIALOG SHOW MODAL hDlg, CALL DlgProc
    
    END FUNCTION
    
    ' -- Dialog callback
    CALLBACK FUNCTION DlgProc () AS LONG
      STATIC hDc, hRc AS DWORD
    
        SELECT CASE CB.MSG
          CASE %WM_INITDIALOG
            hDc = GetDC(CB.HNDL)
    
            LOCAL pfd AS PIXELFORMATDESCRIPTOR
    
            pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)
            pfd.iPixelType      = %PFD_TYPE_RGBA
            pfd.nVersion        = 1
            pfd.dwFlags         = %PFD_DRAW_TO_WINDOW OR %PFD_SUPPORT_OPENGL OR %PFD_DOUBLEBUFFER
            pfd.cColorBits      = 16
            pfd.cDepthBits      = 16
            pfd.iLayerType      = %PFD_MAIN_PLANE
    
            ' -- Set pixel format to device context.
            SetPixelFormat(hDC, ChoosePixelFormat(hDC, pfd), pfd)
    
            hRC = wglCreateContext(hDC)
            wglMakeCurrent hDC, hRC
    
            ' -- Retrieving info
            DIM Extensions(1 TO 1024), ExtensionTypes(1 TO 1024)
            GetInfo(Extensions(), ExtensionTypes(), Renderer, Vendor, OGLVersion )
    
            ' -- Building GUI
            CONTROL ADD LABEL, CB.HNDL, -1, "Renderer", 5, 5, 60, 14
              CONTROL ADD TEXTBOX, CB.HNDL, %edtRenderer, Renderer, 65, 5, 230, 14
    
            CONTROL ADD LABEL, CB.HNDL, -1, "Vendor", 5, 20, 60, 14
              CONTROL ADD TEXTBOX, CB.HNDL, %edtVendor, Vendor, 65, 20, 230, 14
    
            CONTROL ADD LABEL, CB.HNDL, -1, "OpenGL", 5, 35, 60, 14
              CONTROL ADD TEXTBOX, CB.HNDL, %edtOpenGL, OGLVersion, 65, 35, 230, 14
    
            CONTROL ADD LABEL, CB.HNDL, %lblOpenGLStatus, "OpenGL is properly installed", 65, 50, 230, 14, %SS_CENTER OR %SS_CENTERIMAGE
    
            CONTROL ADD LINE, CB.HNDL, -1, "", 5, 70, 290, 1
    
            CONTROL ADD LABEL, CB.HNDL, -1, "Choose extension type", 5, 80, 100, 14
    
            CONTROL ADD LINE, CB.HNDL, -1, "", 5, 255, 290, 1
    
            CONTROL ADD BUTTON, CB.HNDL, %btnSave, "Save report", 5, 265, 60, 14
            CONTROL ADD BUTTON, CB.HNDL, %btnClose, "Exit", 235, 265, 60, 14
            
            ' -- MICROSOFT in Vendor string means we are lost in SW emulation :)
            IF INSTR(UCASE$(Vendor), "MICROSOFT")  THEN
              CONTROL SET TEXT CB.HNDL, %lblOpenGLStatus, " ( SOFTWARE EMULATION )"
              CONTROL SET COLOR CB.HNDL, %lblOpenGLStatus, RGB(255,255,0), RGB(128,0,0)
            ELSE
              CONTROL SET COLOR CB.HNDL, %lblOpenGLStatus, RGB(255,255,0), RGB(0,128,0)
            END IF
    
            CONTROL ADD LINE, CB.HNDL, -1, "", 5, 70, 290, 1
    
            CONTROL ADD LABEL, CB.HNDL, -1, "Choose extension type", 5, 80, 100, 14
    
            CONTROL ADD LISTBOX, CB.HNDL, %listTypes, ExtensionTypes(), 5, 95, 50, 160
              LISTBOX SELECT CB.HNDL, %listTypes, 1
    
            CONTROL ADD LISTBOX, CB.HNDL, %listExtensions, Extensions(), 55, 95, 240, 160
              LISTBOX SELECT CB.HNDL, %listExtensions, 1
    
          ' -- Handling controls
          CASE %WM_COMMAND
            LOCAL i AS LONG
            LOCAL temps AS STRING
            SELECT CASE CB.CTL
    
            CASE %btnSave
              IF CB.CTLMSG = %BN_CLICKED THEN
    
                File_Save( EXE.PATH$ +"OpenGL_Report.txt", "Vendor:"+$TAB+Vendor+$CRLF+ _
                                                            "Renderer:"+$TAB+Renderer+$CRLF+ _
                                                            "OpenGL:"+$TAB+OGLVersion+$CRLF+ _
                                                            "Extensions("+STR$(UBOUND(Extensions))+" ):"+$CRLF+JOIN$(Extensions(), $CRLF))
                MSGBOX "Report saved to "+ EXE.PATH$ +"OpenGL_Report.txt", %MB_ICONINFORMATION OR %MB_OK OR %MB_TASKMODAL, "Info"
              END IF
    
              ' -- Listing extensions by vendor
              CASE %listTypes
                IF CB.CTLMSG = %LBN_SELCHANGE THEN
                  LISTBOX GET TEXT CB.HNDL, %listTypes TO tempS
                  IF tempS = "<All>" THEN
                    LISTBOX RESET CB.HNDL, %listExtensions
    
                    FOR i = 1 TO UBOUND(Extensions)
                        LISTBOX ADD CB.HNDL, %listExtensions, Extensions(i)
                    NEXT
                    
                    LISTBOX SELECT CB.HNDL, %listExtensions, 1
                  ELSE
                    LISTBOX RESET CB.HNDL, %listExtensions
                    FOR i = 1 TO UBOUND(Extensions)
                      IF PARSE$(Extensions(i), "_", 2) = tempS THEN
                        LISTBOX ADD CB.HNDL, %listExtensions, Extensions(i)
                      END IF
                    NEXT
                  END IF
                  LISTBOX SELECT CB.HNDL, %listExtensions, 1
                  CONTROL REDRAW CB.HNDL, %listExtensions
                END IF
    
              ' -- Killing dialog softly
              CASE %btnClose
                DIALOG END CB.HNDL
          END SELECT
    
          ' -- Before it all goes out, we need to terminate OpenGL
          CASE %WM_CLOSE
            wglMakeCurrent  ( 0, %Null)
            wglDeleteContext (hRC)
            ReleaseDC CB.HNDL, hDC
    
        END SELECT
    
    END FUNCTION
    
    
    ' -- Retrieves OpenGL information
    SUB GetInfo( BYREF arr() AS STRING, BYREF arr2() AS STRING, BYREF ren AS STRING, BYREF ven AS STRING, BYREF ogl AS STRING )
    
      LOCAL mText AS STRING
      LOCAL tempS AS STRING
      LOCAL OpenGLInfoPTR AS ASCIIZ PTR
      LOCAL i, index, ID, num AS LONG
    
      ID = 1
      arr2(ID) = "<All>"
    
      OpenGLInfoPTR = glGetString(%GL_VENDOR)
      ven = UCASE$( @OpenGLInfoPTR )
    
      OpenGLInfoPTR = glGetString(%GL_RENDERER)
      ren = UCASE$( @OpenGLInfoPTR )
    
      OpenGLInfoPTR = glGetString(%GL_VERSION)
      ogl = UCASE$( @OpenGLInfoPTR )
    
      OpenGLInfoPTR = glGetString(%GL_EXTENSIONS)
      mText = UCASE$( @OpenGLInfoPTR )
      
      ' -- Extensions are $SPC separated
      mText = TRIM$(mText, $SPC)
      num = PARSECOUNT(mText, $SPC)
      REDIM arr(1 TO num)
      PARSE mText, arr(), $SPC
      
      ' -- Extracting extension types
      FOR i = 1 TO num
        tempS = PARSE$(arr(i), "_", 2)
        ARRAY SCAN arr2(), COLLATE UCASE, =tempS, TO index
        IF index = 0 THEN
          INCR ID
          IF ID > UBOUND(arr2) THEN REDIM PRESERVE arr2(ID)
          arr2(ID) = tempS
    
        END IF
      NEXT
    
    END SUB
    
    ' -- Save buffer to file
    SUB File_Save( fName AS STRING, sBuffer AS STRING )
      DIM f AS INTEGER
    
      f = FREEFILE
    
      IF ISFILE(fName) THEN KILL fName
    
      OPEN fName FOR BINARY AS #f
        PUT$ #f, sBuffer
      CLOSE #f
    
    END SUB
    Attached Files
    [email protected]

  • #2
    Hi Petr, many thanks for your code. If possible can you include in your sample also the opengl.inc file?

    Thanks!

    Sergio

    Comment


    • #3
      See José Roca forum for the include file being used.

      Petr--
      Thank you!
      Patrice Terrier
      www.zapsolution.com
      www.objreader.com
      Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).

      Comment


      • #4
        Josés headers are available from here:
        http://www.jose.it-berater.org/smffo...hp?board=344.0

        I respect the work José put in headers, so I will only link to the original source, also to avoid version problems.
        With his headers, you can code OpenGL 3.0 and DirectX 10, I haven't seen more complete package yet.


        Petr
        Last edited by Petr Schreiber jr; 7 Mar 2009, 08:10 AM.
        [email protected]

        Comment


        • #5
          Many thanks for the link; all worked fine

          bye

          Sergio

          Comment


          • #6
            OpenGl.inc compile error

            I want to play around with the OpenGL.inc intruction sets and compiled the above program in PB08.
            Unfortunately I get the following error in the OpenGL.inc file .

            ' ########################################################################################
            ' OpenGL include files
            ' ########################################################################################
            #IF NOT %DEF(%OPENGL_INC)
            %OPENGL_INC = 1
            #INCLUDE ONCE "WINDOWS.INC"
            #INCLUDE ONCE "GL.INC"
            #INCLUDE ONCE "GLU.INC"
            #ENDIF

            Error : String constant expected ( in line #INCLUDE ONCE "WINDOWS.INC" )

            Does someone has any idea what's wrong ? I can't really find any info about the #include once statement .

            Comment


            • #7
              The clause ONCE does not exist on PB8

              #IF NOT %DEF(%OPENGL_INC)
              %OPENGL_INC = 1
              #INCLUDE "WINDOWS.INC"
              #INCLUDE "GL.INC"
              #INCLUDE "GLU.INC"
              #ENDIF
              "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

              Comment


              • #8
                Once clause in PBWin

                Tanks , the .Inc then must be written for PBWin9 , right ?
                How then to avoid a multiple compilation in PB8 ?
                The ONCE statement is there in order to prevent multiple compilation as several .inc files are imbedded in each other .

                Comment


                • #9
                  Sorry, but as stated in my forum, my include files are unusable with PBWin 8.0. Is not just a matter of INCLUDE ONCE, but also of the inclusion of interface definitions.
                  Forum: http://www.jose.it-berater.org/smfforum/index.php

                  Comment


                  • #10
                    Thanks José , time for me to upgrade then to PBWin9

                    Comment

                    Working...
                    X