Tweet
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
Attached Files
Comment