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.
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
Comment