Deprecated: Array and string offset access syntax with curly braces is deprecated in /homepages/21/d38531796/htdocs/jose/smfforum/Sources/Subs.php on line 3825 Print Page - Changing Textures for OpenGL primitives
Theo's Forum
Legacy Software (PBWIN 9.0+/PBCC 5.0+) => Graphics and Multimedia => Source Code => Topic started by: Frank Brübach on September 19, 2011, 12:50:14 PM
Title: Changing Textures for OpenGL primitives
Post by: Frank Brübach on September 19, 2011, 12:50:14 PM
after some closer studying about openGL texture modifications here I show a little, but in my opinion very useful example for texturing some primitives. You can see different textures by pushing "F" key. you can move scene and objects with arrows (up), (down), (right), (left) and zooming with (pageup, pagedown) too. If you like to blend the objects use "B" key. I can only say that's exciting work if everything is going fine after having some hours of trouble ;)
I am using still pbwin 9.
"Changing texture for openGL primitives" code example:
'----------------> changing texture example for cube, sphere, floor by frank brübach, 17-19.sept.2011 :) '----------------> pbwin 9 '---------------------------------------------------------------------------------------------------->
' SED_PBWIN - Use the PBWIN compiler #COMPILE EXE #DIM ALL #INCLUDE "GLU.INC" #INCLUDE "GDIPLUS.INC" #INCLUDE "GDIPUTILS.INC"
$WindowCaption = "Changing textures for primitives -> push [F]ilter, [B]lending. [up],[down],[left],[right] arrows for rotation"
GLOBAL hDC AS LONG GLOBAL TextureHandles() AS DWORD GLOBAL xrot AS SINGLE GLOBAL yrot AS SINGLE GLOBAL zoom AS SINGLE GLOBAL filter AS LONG GLOBAL xspeed AS SINGLE GLOBAL yspeed AS SINGLE GLOBAL quadratic AS DWORD GLOBAL plane AS DWORD GLOBAL TexFiles() AS STRING GLOBAL g_bBlending AS LONG
TYPE WNDCLASSEX cbSize AS DWORD STYLE AS DWORD lpfnWndProc AS LONG cbClsExtra AS LONG cbWndExtra AS LONG hInstance AS DWORD hIcon AS DWORD hCursor AS DWORD hbrBackground AS DWORD lpszMenuName AS ASCIIZ PTR lpszClassName AS ASCIIZ PTR hIconSm AS DWORD END TYPE
' ======================================================================================= ' All the setup goes here ' ======================================================================================= SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DIM LightAmbient(3) AS SINGLE DIM LightDiffuse(3) AS SINGLE DIM LightPosition(3) AS SINGLE
REDIM TexFiles(0 TO 2) AS GLOBAL STRING TexFiles(0) = "ball.bmp" TexFiles(1) = "wall.bmp" TexFiles(2) = "envwall.bmp" CALL JH_MakeTextures(3)
'Activate last Handle from the created Textures CALL glEnable(%GL_TEXTURE_2D) '-----------------------------------> Plane = glGenLists(2) glNewList Plane, %GL_COMPILE glTranslatef 6.5!, -18.5!, -15.0!
' Specify clear values for the color buffers glClearColor 0.0!, 0.0!, 0.4!, 0.0! ' Specify the clear value for the depth buffer glClearDepth 1.0! ' Specify the value used for depth-buffer comparisons glDepthFunc %GL_LESS ' Enable depth comparisons and update the depth buffer glEnable %GL_DEPTH_TEST ' Select smooth shading glShadeModel %GL_SMOOTH
zoom = -5.0 END SUB ' =======================================================================================
' ======================================================================================= ' Resize the scene ' ======================================================================================= SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one IF nHeight = 0 THEN nHeight = 1 ' Reset the current viewport glViewport 0, 0, nWidth, nHeight ' Select the projection matrix glMatrixMode %GL_PROJECTION ' Reset the projection matrix glLoadIdentity ' Calculate the aspect ratio of the window gluPerspective 65.0!, nWidth / nHeight, 0.1!, 100.0! ' Select the model view matrix glMatrixMode %GL_MODELVIEW ' Reset the model view matrix glLoadIdentity
END SUB ' =======================================================================================
' ======================================================================================= ' Draw the scene ' ======================================================================================= SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Clear the screen buffer glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT ' Reset the view glLoadIdentity
IF g_bBlending THEN glDisable(%GL_DEPTH_TEST) ' // Set up blending... glEnable(%GL_BLEND) glBlendFunc(%GL_SRC_ALPHA, %GL_ONE) glDisable(%GL_DEPTH_TEST) ELSE glDisable(%GL_BLEND) glEnable(%GL_DEPTH_TEST) END IF
END SUB ' =======================================================================================
' ======================================================================================= ' Cleanup ' ======================================================================================= SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the texture glDeleteTextures(3, TextureHandles(0))
END SUB ' =======================================================================================
' ======================================================================================= SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
STATIC lp, fp, light AS LONG
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE ' Quit if Esc key pressed SendMessage hwnd, %WM_CLOSE, 0, 0
CASE %VK_L IF ISTRUE bKeyDown AND ISFALSE lp THEN lp = %TRUE light = NOT light IF ISFALSE light THEN glDisable %GL_LIGHTING ELSE glEnable %GL_LIGHTING END IF END IF IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_B IF bKeyDown THEN g_bBlending = NOT g_bBlending
CASE %VK_L IF ISTRUE bKeyDown AND ISFALSE lp THEN lp = %TRUE light = NOT light IF ISFALSE light THEN glDisable %GL_LIGHTING ELSE glEnable %GL_LIGHTING END IF END IF IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_F IF ISTRUE bKeyDown AND ISFALSE fp THEN fp = %TRUE filter = filter + 1 IF filter > 2 THEN filter = 0 END IF IF ISFALSE bKeyDown THEN fp = %FALSE
CASE %VK_PGUP IF ISTRUE bKeyDown THEN zoom = zoom - 0.02!
CASE %VK_PGDN IF ISTRUE bKeyDown THEN zoom = zoom + 0.02!
CASE %VK_UP IF ISTRUE bKeyDown THEN xspeed = xspeed - 0.01!
CASE %VK_DOWN IF ISTRUE bKeyDown THEN xspeed = xspeed + 0.01!
CASE %VK_LEFT IF ISTRUE bKeyDown THEN yspeed = yspeed - 0.01!
CASE %VK_RIGHT IF ISTRUE bKeyDown THEN yspeed = yspeed + 0.01!
END SELECT
END SUB ' =======================================================================================
' ======================================================================================= ' Main ' ======================================================================================= FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD LOCAL wcex AS WNDCLASSEX LOCAL szClassName AS ASCIIZ * 256 LOCAL szCaption AS ASCIIZ * 256 LOCAL msg AS tagMSG LOCAL rc AS RECT LOCAL bDone AS LONG LOCAL nLeft AS LONG LOCAL nTop AS LONG LOCAL nWidth AS LONG LOCAL nHeight AS LONG LOCAL dwStyle AS DWORD LOCAL dwStyleEx AS DWORD STATIC vKeyCode AS LONG STATIC bKeyDown AS LONG LOCAL t AS DOUBLE LOCAL t0 AS DOUBLE LOCAL fps AS DOUBLE LOCAL nFrames AS LONG LOCAL dm AS DEVMODE LOCAL bFullScreen AS LONG LOCAL lResult AS LONG
' Register the window class szClassName = "PBOPENGL" wcex.cbSize = SIZEOF(wcex) wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC wcex.lpfnWndProc = CODEPTR(WndProc) wcex.cbClsExtra = 0 wcex.cbWndExtra = 0 wcex.hInstance = hInstance wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW) wcex.hbrBackground = %NULL wcex.lpszMenuName = %NULL wcex.lpszClassName = VARPTR(szClassName) wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON") wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too.. RegisterClassEx wcex
' Ask the user which screen mode he prefers lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _ "Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION) SELECT CASE lResult CASE %IDCANCEL : EXIT FUNCTION CASE %IDYES : bFullScreen = %TRUE CASE %IDNO : bFullScreen = %FALSE END SELECT
IF bFullScreen THEN ' Change display settings dm.dmSize = SIZEOF(dm) dm.dmPelsWidth = nWidth dm.dmPelsHeight = nHeight dm.dmBitsPerPel = %GL_BITSPERPEL dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE END IF
' Window caption szCaption = $WindowCaption
' Window styles IF ISFALSE bFullScreen THEN dwStyle = %WS_OVERLAPPEDWINDOW dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE ELSE dwStyle = %WS_POPUP dwStyleEx = %WS_EX_APPWINDOW END IF
' Retrieve the coordinates of the window's client area GetClientRect hwnd, rc ' Initialize the new OpenGl window SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window ShowWindow hwnd, nCmdShow UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE) IF msg.message = %WM_QUIT THEN bDone = %TRUE ELSE IF msg.message = %WM_KEYDOWN THEN vKeyCode = msg.wParam bKeyDown = %TRUE ELSEIF msg.message = %WM_KEYUP THEN vKeyCode = msg.wParam bKeyDown = %FALSE END IF TranslateMessage msg DispatchMessage msg END IF LOOP
IF ISFALSE bFullScreen THEN ' Get time and mouse position t = INT(TIMER) ' Calculate and display FPS (frames per second) IF t > t0 OR nFrames = 0 THEN fps = nFrames \ (t - t0) wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps SetWindowText hwnd, szCaption t0 = t nFrames = 0 END IF nFrames = nFrames + 1 END IF
' Draw the scene DrawScene hwnd, nWidth, nHeight ' Exchange the front and back buffers SwapBuffers hDC
' Process the keystrokes IF vKeyCode THEN ProcessKeystrokes hwnd, vKeyCode, bKeyDown vKeyCode = 0 END IF
LOOP
' Retore defaults IF bFullScreen THEN ChangeDisplaySettings BYVAL %NULL, 0 ShowCursor %TRUE END IF
FUNCTION = msg.wParam
END FUNCTION ' =======================================================================================
' ======================================================================================= ' Main window procedure ' ======================================================================================= FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG LOCAL pfd AS PIXELFORMATDESCRIPTOR STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window IF (wParam AND &HFFF0) = %SC_CLOSE THEN SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
CASE %WM_CREATE
' Retrieve the device context handle hDC = GetDC(hwnd)
' Find a matching pixel format pf = ChoosePixelFormat(hDC, pfd) IF ISFALSE pf THEN MessageBox hwnd, "Can't find a suitable pixel format", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Set the pixel format IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN MessageBox hwnd, "Can't set the pixel format", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Create a new OpenGL rendering context hRC = wglCreateContext(hDC) IF ISFALSE hRC THEN MessageBox hwnd, "Can't create an OpenGL rendering context", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Make it current IF ISFALSE wglMakeCurrent(hDC,hRC) THEN MessageBox hwnd, "Can't activate the OpenGL rendering context", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
EXIT FUNCTION
CASE %WM_DESTROY ' Clear resources Cleanup hwnd ' Release the device and rendering contexts wglMakeCurrent hDC, 0 ' Make the rendering context no longer current wglDeleteContext hRC ' Release the device context ReleaseDC hwnd, hDC ' Post an WM_QUIT message PostQuitMessage 0 EXIT FUNCTION
CASE %WM_SIZE ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam) EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION ' ==========================================================================
SUB JH_MakeTextures(BYVAL nTextureCount AS LONG) LOCAL xn, xi AS LONG xi = nTextureCount -1 REDIM TextureHandles(0 TO xi) DIM TextureWidth(0 TO xi) AS LONG DIM TextureHeight(0 TO xi) AS LONG DIM strTextureData(0 TO xi) AS STRING
'Enable texture mapping CALL glEnable(%GL_TEXTURE_2D) FOR xn = 0 TO xi
'Load TextureData from File on Disk IF GdiPlusLoadTexture(TexFiles(xn), TextureWidth(xn), TextureHeight(xn), strTextureData(xn), %TRUE) = 0 THEN
'Assign an Array for OpenGL Handles of Textures in Memory IF xn = 0 THEN glGenTextures nTextureCount, TextureHandles(0) 'MSGBOX ": "+FORMAT$(nTextureCount) + $CR +"File number.: "+FORMAT$(xn) + $CR +"Name: "+ TexFiles(xn) '<-- check Input via MsgBoxy
' Create Linear Filtered Texture glBindTexture %GL_TEXTURE_2D, TextureHandles(xn) glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MAG_FILTER,%GL_LINEAR glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MIN_FILTER,%GL_LINEAR glTexImage2D %GL_TEXTURE_2D, 0, 4, TextureWidth(xn), TextureHeight(xn), 0, _ %GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData(xn)) END IF NEXT END SUB new edit: all you need you can find in zip folder in next post. pictures of scene I add here too.
best regards, frank
Title: Re: Changing Textures for OpenGL primitives
Post by: Frank Brübach on September 19, 2011, 01:31:46 PM
sorry, forgotten to send correct example: here you can see whole changing of cube, sphere and floor texturing. If you like to make your own modification you only need to change these two lines with wished texture you can add with own bitmap or png files.
'----------------> changing texture example for cube, sphere, floor by frank brübach, 17-19.sept.2011 :) '----------------> pbwin 9 '---------------------------------------------------------------------------------------------------->
' SED_PBWIN - Use the PBWIN compiler #COMPILE EXE #DIM ALL #INCLUDE "GLU.INC" #INCLUDE "GDIPLUS.INC" #INCLUDE "GDIPUTILS.INC"
$WindowCaption = "Changing textures for primitives 1a-> push [F]ilter, [B]lending. [up],[down],[left],[right] arrows for rotation"
GLOBAL hDC AS LONG GLOBAL TextureHandles() AS DWORD GLOBAL xrot AS SINGLE GLOBAL yrot AS SINGLE GLOBAL zoom AS SINGLE GLOBAL filter AS LONG GLOBAL xspeed AS SINGLE GLOBAL yspeed AS SINGLE GLOBAL quadratic AS DWORD GLOBAL plane AS DWORD GLOBAL TexFiles() AS STRING GLOBAL g_bBlending AS LONG
TYPE WNDCLASSEX cbSize AS DWORD STYLE AS DWORD lpfnWndProc AS LONG cbClsExtra AS LONG cbWndExtra AS LONG hInstance AS DWORD hIcon AS DWORD hCursor AS DWORD hbrBackground AS DWORD lpszMenuName AS ASCIIZ PTR lpszClassName AS ASCIIZ PTR hIconSm AS DWORD END TYPE
' ======================================================================================= ' All the setup goes here ' ======================================================================================= SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DIM LightAmbient(3) AS SINGLE DIM LightDiffuse(3) AS SINGLE DIM LightPosition(3) AS SINGLE
REDIM TexFiles(0 TO 2) AS GLOBAL STRING TexFiles(0) = "ball.bmp" TexFiles(1) = "wall.bmp" TexFiles(2) = "envwall.bmp" CALL JH_MakeTextures(3)
'Activate last Handle from the created Textures CALL glEnable(%GL_TEXTURE_2D) '-----------------------------------> Plane = glGenLists(2) glNewList Plane, %GL_COMPILE glTranslatef 6.5!, -18.5!, -15.0!
' Specify clear values for the color buffers glClearColor 0.0!, 0.0!, 0.4!, 0.0! ' Specify the clear value for the depth buffer glClearDepth 1.0! ' Specify the value used for depth-buffer comparisons glDepthFunc %GL_LESS ' Enable depth comparisons and update the depth buffer glEnable %GL_DEPTH_TEST ' Select smooth shading glShadeModel %GL_SMOOTH
zoom = -5.0 END SUB ' =======================================================================================
' ======================================================================================= ' Resize the scene ' ======================================================================================= SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Prevent divide by zero making height equal one IF nHeight = 0 THEN nHeight = 1 ' Reset the current viewport glViewport 0, 0, nWidth, nHeight ' Select the projection matrix glMatrixMode %GL_PROJECTION ' Reset the projection matrix glLoadIdentity ' Calculate the aspect ratio of the window gluPerspective 65.0!, nWidth / nHeight, 0.1!, 100.0! ' Select the model view matrix glMatrixMode %GL_MODELVIEW ' Reset the model view matrix glLoadIdentity
END SUB ' =======================================================================================
' ======================================================================================= ' Draw the scene ' ======================================================================================= SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
' Clear the screen buffer glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT ' Reset the view glLoadIdentity
IF g_bBlending THEN glDisable(%GL_DEPTH_TEST) ' // Set up blending... glEnable(%GL_BLEND) glBlendFunc(%GL_SRC_ALPHA, %GL_ONE) glDisable(%GL_DEPTH_TEST) ELSE glDisable(%GL_BLEND) glEnable(%GL_DEPTH_TEST) END IF
END SUB ' =======================================================================================
' ======================================================================================= ' Cleanup ' ======================================================================================= SUB Cleanup (BYVAL hwnd AS DWORD)
' Delete the texture glDeleteTextures(3, TextureHandles(0))
END SUB ' =======================================================================================
' ======================================================================================= SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
STATIC lp, fp, light AS LONG
SELECT CASE AS LONG vKeyCode
CASE %VK_ESCAPE ' Quit if Esc key pressed SendMessage hwnd, %WM_CLOSE, 0, 0
CASE %VK_L IF ISTRUE bKeyDown AND ISFALSE lp THEN lp = %TRUE light = NOT light IF ISFALSE light THEN glDisable %GL_LIGHTING ELSE glEnable %GL_LIGHTING END IF END IF IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_B IF bKeyDown THEN g_bBlending = NOT g_bBlending
CASE %VK_L IF ISTRUE bKeyDown AND ISFALSE lp THEN lp = %TRUE light = NOT light IF ISFALSE light THEN glDisable %GL_LIGHTING ELSE glEnable %GL_LIGHTING END IF END IF IF ISFALSE bKeyDown THEN lp = %FALSE
CASE %VK_F IF ISTRUE bKeyDown AND ISFALSE fp THEN fp = %TRUE filter = filter + 1 IF filter > 2 THEN filter = 0 END IF IF ISFALSE bKeyDown THEN fp = %FALSE
CASE %VK_PGUP IF ISTRUE bKeyDown THEN zoom = zoom - 0.02!
CASE %VK_PGDN IF ISTRUE bKeyDown THEN zoom = zoom + 0.02!
CASE %VK_UP IF ISTRUE bKeyDown THEN xspeed = xspeed - 0.01!
CASE %VK_DOWN IF ISTRUE bKeyDown THEN xspeed = xspeed + 0.01!
CASE %VK_LEFT IF ISTRUE bKeyDown THEN yspeed = yspeed - 0.01!
CASE %VK_RIGHT IF ISTRUE bKeyDown THEN yspeed = yspeed + 0.01!
END SELECT
END SUB ' =======================================================================================
' ======================================================================================= ' Main ' ======================================================================================= FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD LOCAL wcex AS WNDCLASSEX LOCAL szClassName AS ASCIIZ * 256 LOCAL szCaption AS ASCIIZ * 256 LOCAL msg AS tagMSG LOCAL rc AS RECT LOCAL bDone AS LONG LOCAL nLeft AS LONG LOCAL nTop AS LONG LOCAL nWidth AS LONG LOCAL nHeight AS LONG LOCAL dwStyle AS DWORD LOCAL dwStyleEx AS DWORD STATIC vKeyCode AS LONG STATIC bKeyDown AS LONG LOCAL t AS DOUBLE LOCAL t0 AS DOUBLE LOCAL fps AS DOUBLE LOCAL nFrames AS LONG LOCAL dm AS DEVMODE LOCAL bFullScreen AS LONG LOCAL lResult AS LONG
' Register the window class szClassName = "PBOPENGL" wcex.cbSize = SIZEOF(wcex) wcex.style = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC wcex.lpfnWndProc = CODEPTR(WndProc) wcex.cbClsExtra = 0 wcex.cbWndExtra = 0 wcex.hInstance = hInstance wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW) wcex.hbrBackground = %NULL wcex.lpszMenuName = %NULL wcex.lpszClassName = VARPTR(szClassName) wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON") wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too.. RegisterClassEx wcex
' Ask the user which screen mode he prefers lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _ "Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION) SELECT CASE lResult CASE %IDCANCEL : EXIT FUNCTION CASE %IDYES : bFullScreen = %TRUE CASE %IDNO : bFullScreen = %FALSE END SELECT
IF bFullScreen THEN ' Change display settings dm.dmSize = SIZEOF(dm) dm.dmPelsWidth = nWidth dm.dmPelsHeight = nHeight dm.dmBitsPerPel = %GL_BITSPERPEL dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE END IF
' Window caption szCaption = $WindowCaption
' Window styles IF ISFALSE bFullScreen THEN dwStyle = %WS_OVERLAPPEDWINDOW dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE ELSE dwStyle = %WS_POPUP dwStyleEx = %WS_EX_APPWINDOW END IF
' Retrieve the coordinates of the window's client area GetClientRect hwnd, rc ' Initialize the new OpenGl window SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop
' Show the window ShowWindow hwnd, nCmdShow UpdateWindow hwnd
DO UNTIL bDone
' Windows message pump DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE) IF msg.message = %WM_QUIT THEN bDone = %TRUE ELSE IF msg.message = %WM_KEYDOWN THEN vKeyCode = msg.wParam bKeyDown = %TRUE ELSEIF msg.message = %WM_KEYUP THEN vKeyCode = msg.wParam bKeyDown = %FALSE END IF TranslateMessage msg DispatchMessage msg END IF LOOP
IF ISFALSE bFullScreen THEN ' Get time and mouse position t = INT(TIMER) ' Calculate and display FPS (frames per second) IF t > t0 OR nFrames = 0 THEN fps = nFrames \ (t - t0) wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps SetWindowText hwnd, szCaption t0 = t nFrames = 0 END IF nFrames = nFrames + 1 END IF
' Draw the scene DrawScene hwnd, nWidth, nHeight ' Exchange the front and back buffers SwapBuffers hDC
' Process the keystrokes IF vKeyCode THEN ProcessKeystrokes hwnd, vKeyCode, bKeyDown vKeyCode = 0 END IF
LOOP
' Retore defaults IF bFullScreen THEN ChangeDisplaySettings BYVAL %NULL, 0 ShowCursor %TRUE END IF
FUNCTION = msg.wParam
END FUNCTION ' =======================================================================================
' ======================================================================================= ' Main window procedure ' ======================================================================================= FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG LOCAL pfd AS PIXELFORMATDESCRIPTOR STATIC hRC AS LONG
SELECT CASE wMsg
CASE %WM_SYSCOMMAND
' Disable the Windows screensaver IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
' Close the window IF (wParam AND &HFFF0) = %SC_CLOSE THEN SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
CASE %WM_CREATE
' Retrieve the device context handle hDC = GetDC(hwnd)
' Find a matching pixel format pf = ChoosePixelFormat(hDC, pfd) IF ISFALSE pf THEN MessageBox hwnd, "Can't find a suitable pixel format", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Set the pixel format IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN MessageBox hwnd, "Can't set the pixel format", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Create a new OpenGL rendering context hRC = wglCreateContext(hDC) IF ISFALSE hRC THEN MessageBox hwnd, "Can't create an OpenGL rendering context", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
' Make it current IF ISFALSE wglMakeCurrent(hDC,hRC) THEN MessageBox hwnd, "Can't activate the OpenGL rendering context", _ "Error", %MB_OK OR %MB_ICONEXCLAMATION SendMessage hwnd, %WM_CLOSE, 0, 0 EXIT FUNCTION END IF
EXIT FUNCTION
CASE %WM_DESTROY ' Clear resources Cleanup hwnd ' Release the device and rendering contexts wglMakeCurrent hDC, 0 ' Make the rendering context no longer current wglDeleteContext hRC ' Release the device context ReleaseDC hwnd, hDC ' Post an WM_QUIT message PostQuitMessage 0 EXIT FUNCTION
CASE %WM_SIZE ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam) EXIT FUNCTION
END SELECT
' Call the default window procedure to process unhandled messages FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION ' ==========================================================================
SUB JH_MakeTextures(BYVAL nTextureCount AS LONG) LOCAL xn, xi AS LONG xi = nTextureCount -1 REDIM TextureHandles(0 TO xi) DIM TextureWidth(0 TO xi) AS LONG DIM TextureHeight(0 TO xi) AS LONG DIM strTextureData(0 TO xi) AS STRING
'Enable texture mapping CALL glEnable(%GL_TEXTURE_2D) FOR xn = 0 TO xi
'Load TextureData from File on Disk IF GdiPlusLoadTexture(TexFiles(xn), TextureWidth(xn), TextureHeight(xn), strTextureData(xn), %TRUE) = 0 THEN
'Assign an Array for OpenGL Handles of Textures in Memory IF xn = 0 THEN glGenTextures nTextureCount, TextureHandles(0) 'MSGBOX ": "+FORMAT$(nTextureCount) + $CR +"File number.: "+FORMAT$(xn) + $CR +"Name: "+ TexFiles(xn) '<-- check Input via MsgBoxy
' Create Linear Filtered Texture glBindTexture %GL_TEXTURE_2D, TextureHandles(xn) glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MAG_FILTER,%GL_LINEAR glTexParameteri %GL_TEXTURE_2D,%GL_TEXTURE_MIN_FILTER,%GL_LINEAR glTexImage2D %GL_TEXTURE_2D, 0, 4, TextureWidth(xn), TextureHeight(xn), 0, _ %GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData(xn)) END IF NEXT END SUB thanks, frank