• Welcome to PlanetSquires Forums.
 

CWindow Release Candidate 29

Started by José Roca, July 01, 2017, 04:21:09 PM

Previous topic - Next topic

José Roca

Incorporates some changes commented in the thread for the previous version and two new classes:

CShortcut - Class to create shortcuts
CRegExp - VB Script regular expressions

On-line help: http://www.jose.it-berater.org/CWindow/CWindowFramework.html

I think that we already have a very complete framework. If you notice bugs in the code or mistakes in the documentation (quite probably, since this is the most boring part, and there are about 3400 pages) please report them.

Update: The file CWindow_RC_29_Update.rar contains an update of AfxGdiPlus.inc, with two new proedures to load textures for OpenGL, and a new file, AfxGlut.inc, with procedures for generating 3-D geometric objects. You will need them if you intend to follow the upcoming OpenGL examples.

Fredrikk

DL'ing it now. Just curious, will you still support offline help?

José Roca

Yes, but first I have to solve an small problem.

José Roca

CWindow OpenGL template.


' ########################################################################################
' Microsoft Windows
' File: CW_OGL_Template.fbtpl
' Contents: CWindow OpenGL Template
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
USING Afx

CONST WindowCaption = "OpenGL Template"

CONST GL_WINDOWWIDTH  = 640         ' Window width
CONST GL_WINDOWHEIGHT = 450         ' Window height
CONST GL_BITSPERPEL   = 24          ' Color resolution in bits per pixel
CONST GL_DEPTHBITS    = 32          ' Depth of the depth (z-axis) buffer

DIM SHARED g_hDC AS HDC             ' Device context handle


DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB ResizeScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB DrawScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB Cleanup (BYVAL hwnd AS HWND)
DECLARE SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
DECLARE SUB ProcessMouse (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Specify clear values for the color buffers
   glClearColor 0.0, 0.0, 0.0, 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

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS HWND, 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 45.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 HWND, 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

   ' ------------------------------------------------------------------------------------
   ' Sample code. Replace it with your own code.
   ' ------------------------------------------------------------------------------------

   glTranslatef -1.5, 0.0, -6.0          ' Move left 1.5 units and into the screen 6.0

   glBegin GL_TRIANGLES                  ' Drawing using triangles
      glColor3f   1.0, 0.0, 0.0          ' Set the color to red
      glVertex3f  0.0, 1.0, 0.0          ' Top
      glColor3f   0.0, 1.0, 0.0          ' Set the color to green
      glVertex3f  1.0,-1.0, 0.0          ' Bottom right
      glColor3f   0.0, 0.0, 1.0          ' Set the color to blue
      glVertex3f -1.0,-1.0, 0.0          ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0,0.0,0.0              ' Move right 3 units

   glColor3f 0.5, 0.5, 1.0               ' Set the color to blue one time only
   glBegin GL_QUADS                      ' Draw a quad
      glVertex3f -1.0, 1.0, 0.0          ' Top left
      glVertex3f  1.0, 1.0, 0.0          ' Top right
      glVertex3f  1.0,-1.0, 0.0          ' Bottom right
      glVertex3f -1.0,-1.0, 0.0          ' Bottom left
   glEnd                                 ' Done drawing the quad


END SUB
' =======================================================================================

' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS HWND)

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

END SUB
' =======================================================================================

' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

   SELECT CASE vKeyCode

      CASE VK_ESCAPE
         ' // Quit if Esc key pressed
         SendMessageW hwnd, WM_CLOSE, 0, 0

   END SELECT

END SUB
' =======================================================================================

' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * hwnd      = Window hande
' * uMsg      = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
'               MK_CONTROL    The CTRL key is down.
'               MK_LBUTTON    The left mouse button is down.
'               MK_MBUTTON    The middle mouse button is down.
'               MK_RBUTTON    The right mouse button is down.
'               MK_SHIFT      The SHIFT key is down.
'               MK_XBUTTON1   Windows 2000/XP: The first X button is down.
'               MK_XBUTTON2   Windows 2000/XP: The second X button is down.
' * x         = x-coordinate of the cursor
' * y         = y-coordinate of the cursor
' =======================================================================================
SUB ProcessMouse (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

   SELECT CASE uMsg

      CASE WM_LBUTTONDOWN

      CASE WM_LBUTTONUP

      CASE WM_MOUSEMOVE

   END SELECT

END SUB
' =======================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   ' // Create the window
   DIM hwndMain AS HWND = pWindow.Create(NULL, WindowCaption, @WndProc)
   ' // Don't erase nackground
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Black brush
   pWindow.Brush = CreateSolidBrush(BGR(0, 0, 0))
   ' // Sizes the window by setting the wanted width and height of its client area
   pWindow.SetClientSize(GL_WINDOWWIDTH, GL_WINDOWHEIGHT)
   ' // Centers the window
   pWindow.Center

   ' // Retrieve the coordinates of the window's client area
   DIM rc AS RECT
   GetClientRect hwndMain, @rc
   ' // Initialize the new OpenGL window
   SetupScene hwndMain, rc.Right - rc.Left, rc.Bottom - rc.Top

   ' // Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' // Optional timing code
   DIM t AS DOUBLE
   DIM t0 AS DOUBLE
   DIM fps AS DOUBLE
   DIM nFrames AS LONG
   DIM wszCaption AS WSTRING * 256

   ' // Process Windows messages
   DIM msg AS tagMSG
   DIM bDone AS BOOLEAN
   STATIC vKeyCode AS LONG
   STATIC bKeyDown AS BOOLEAN

   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

      ' // Optional timing code
      ' // 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)
         wszCaption = WindowCaption & " (" & STR(fps) & "FPS)"
         SetWindowTextW hwndMain, @wszCaption
         t0 = t
         nFrames = 0
      END IF
      nFrames = nFrames + 1

      ' // Draw the scene
      DrawScene hwndMain, GL_WINDOWWIDTH, GL_WINDOWHEIGHT
      ' // Exchange the front and back buffers
      SwapBuffers g_hDC

      ' // Process the keystrokes
      IF vKeyCode THEN
         ProcessKeystrokes hwndMain, vKeyCode, bKeyDown
         vKeyCode = 0
      END IF

   LOOP

   FUNCTION = msg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   DIM  pf  AS LONG
   DIM  pfd AS PIXELFORMATDESCRIPTOR
   STATIC hRC AS HGLRC

   SELECT CASE uMsg

      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
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE WM_CREATE
         ' // Retrieve the device context handle
         g_hDC = GetDC(hwnd)

         ' // Fill the PIXELFORMATDESCRIPTOR structure
         pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)   ' Size of the structure
         pfd.nVersion        = 1                               ' Version number
         pfd.dwFlags         = PFD_DRAW_TO_WINDOW _            ' Format must support window
                               OR PFD_SUPPORT_OPENGL _         ' Format must support OpenGL
                               OR PFD_DOUBLEBUFFER             ' Format must support double buffering
         pfd.iPixelType      = PFD_TYPE_RGBA                   ' Request an RGBA format
         pfd.cColorBits      = GL_BITSPERPEL                   ' Number of color bitplanes in each color buffer
         pfd.cRedBits        = 0                               ' Number of red bitplanes in each RGBA color buffer.
         pfd.cRedShift       = 0                               ' Shift count for red bitplanes in each RGBA color buffer.
         pfd.cGreenBits      = 0                               ' Number of green bitplanes in each RGBA color buffer.
         pfd.cGreenShift     = 0                               ' Shift count for green bitplanes in each RGBA color buffer.
         pfd.cBlueBits       = 0                               ' Number of blue bitplanes in each RGBA color buffer.
         pfd.cBlueShift      = 0                               ' Shift count for blue bitplanes in each RGBA color buffer.
         pfd.cAlphaBits      = 0                               ' Number of alpha bitplanes in each RGBA color buffer
         pfd.cAlphaShift     = 0                               ' Shift count for alpha bitplanes in each RGBA color buffer.
         pfd.cAccumBits      = 0                               ' Total number of bitplanes in the accumulation buffer.
         pfd.cAccumRedBits   = 0                               ' Number of red bitplanes in the accumulation buffer.
         pfd.cAccumGreenBits = 0                               ' Number of gree bitplanes in the accumulation buffer.
         pfd.cAccumBlueBits  = 0                               ' Number of blue bitplanes in the accumulation buffer.
         pfd.cAccumAlphaBits = 0                               ' Number of alpha bitplanes in the accumulation buffer.
         pfd.cDepthBits      = GL_DEPTHBITS                    ' Depth of the depth (z-axis) buffer.
         pfd.cStencilBits    = 0                               ' Depth of the stencil buffer.
         pfd.cAuxBuffers     = 0                               ' Number of auxiliary buffers.
         pfd.iLayerType      = 0 ' PFD_MAIN_PLANE              ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.bReserved       = 0                               ' Number of overlay and underlay planes.
         pfd.dwLayerMask     = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.dwVisibleMask   = 0                               ' Transparent color or index of an underlay plane.
         pfd.dwDamageMask    = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.

         ' // Find a matching pixel format
         pf = ChoosePixelFormat(g_hDC, @pfd)
         IF pf = 0 THEN
            MessageBoxW hwnd, "Can't find a suitable pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Set the pixel format
         IF SetPixelFormat(g_hDC, pf, @pfd) = FALSE THEN
            MessageBoxW hwnd, "Can't set the pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Create a new OpenGL rendering context
         hRC = wglCreateContext(g_hDC)
         IF hRC = NULL THEN
            MessageBoxW hwnd, "Can't create an OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Make it current
         IF wglMakeCurrent(g_hDC, hRC) = FALSE THEN
            MessageBoxW hwnd, "Can't activate the OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         EXIT FUNCTION

    CASE WM_DESTROY
         ' // Clean resources
         Cleanup hwnd
         ' // Release the device and rendering contexts
         wglMakeCurrent g_hDC, NULL
         ' // Make the rendering context no longer current
         wglDeleteContext hRC
         ' // Release the device context
         ReleaseDC hwnd, g_hDC
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

      CASE WM_SIZE
         ResizeScene hwnd, LOWORD(lParam), HIWORD(lParam)
         EXIT FUNCTION

      CASE WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE
         ProcessMouse hwnd, uMsg, wParam, LOWORD(lParam), HIWORD(lParam)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

NeHe Lesson 4.


' ########################################################################################
' Microsoft Windows
' File: CW_OGL_Nehe_04
' Contents: CWindow OpenGL - NeHe lesson 4
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
USING Afx

CONST WindowCaption = "NeHe Lesson 4"

CONST GL_WINDOWWIDTH  = 640         ' Window width
CONST GL_WINDOWHEIGHT = 450         ' Window height
CONST GL_BITSPERPEL   = 24          ' Color resolution in bits per pixel
CONST GL_DEPTHBITS    = 32          ' Depth of the depth (z-axis) buffer

DIM SHARED g_hDC AS HDC             ' Device context handle
DIM SHARED rtri AS SINGLE
DIM SHARED rquad AS SINGLE

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB ResizeScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB DrawScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Specify clear values for the color buffers
   glClearColor 0.0, 0.0, 0.0, 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

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS HWND, 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 45.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 HWND, 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

   glTranslatef -1.5, 0.0, -6.0          ' Move left 1.5 units and into the screen 6.0
   glRotatef rtri, 0.0, 1.0, 0.0         ' Rotate the triangle on the Y axis

   glBegin GL_TRIANGLES                  ' Drawing using triangles
      glColor3f   1.0, 0.0, 0.0          ' Set the color to red
      glVertex3f  0.0, 1.0, 0.0          ' Top
      glColor3f   0.0, 1.0, 0.0          ' Set the color to green
      glVertex3f  1.0,-1.0, 0.0          ' Bottom right
      glColor3f   0.0, 0.0, 1.0          ' Set the color to blue
      glVertex3f -1.0,-1.0, 0.0          ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glLoadIdentity                        ' Reset The Current Modelview Matrix
   glTranslatef 1.5, 0.0, -6.0           ' Move right 1.5 units and into the screen 6.0
   glRotatef rquad, 1.0, 0.0, 0.0        ' Rotate the quad on the X axis

   glColor3f 0.5, 0.5, 1.0               ' Set the color to blue one time only
   glBegin GL_QUADS                      ' Draw a quad
      glVertex3f -1.0, 1.0, 0.0          ' Top left
      glVertex3f  1.0, 1.0, 0.0          ' Top right
      glVertex3f  1.0,-1.0, 0.0          ' Bottom right
      glVertex3f -1.0,-1.0, 0.0          ' Bottom left
   glEnd                                 ' Done drawing the quad

   rtri = rtri + 0.2                     ' Increase the rotation variable for the triangle ( New )
   rquad = rquad - 0.15                  ' Decrease the rotation variable for the quad ( New )

END SUB
' =======================================================================================

' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

   SELECT CASE vKeyCode

      CASE VK_ESCAPE
         ' // Quit if Esc key pressed
         SendMessageW hwnd, WM_CLOSE, 0, 0

   END SELECT

END SUB
' =======================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   ' // Create the window
   DIM hwndMain AS HWND = pWindow.Create(NULL, WindowCaption, @WndProc)
   ' // Don't erase nackground
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Black brush
   pWindow.Brush = CreateSolidBrush(BGR(0, 0, 0))
   ' // Sizes the window by setting the wanted width and height of its client area
   pWindow.SetClientSize(GL_WINDOWWIDTH, GL_WINDOWHEIGHT)
   ' // Centers the window
   pWindow.Center

   ' // Retrieve the coordinates of the window's client area
   DIM rc AS RECT
   GetClientRect hwndMain, @rc
   ' // Initialize the new OpenGL window
   SetupScene hwndMain, rc.Right - rc.Left, rc.Bottom - rc.Top

   ' // Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' // Optional timing code
   DIM t AS DOUBLE
   DIM t0 AS DOUBLE
   DIM fps AS DOUBLE
   DIM nFrames AS LONG
   DIM wszCaption AS WSTRING * 256

   ' // Process Windows messages
   DIM msg AS tagMSG
   DIM bDone AS BOOLEAN
   STATIC vKeyCode AS LONG
   STATIC bKeyDown AS BOOLEAN

   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

      ' // Optional timing code
      ' // 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)
         wszCaption = WindowCaption & " (" & STR(fps) & "FPS)"
         SetWindowTextW hwndMain, @wszCaption
         t0 = t
         nFrames = 0
      END IF
      nFrames = nFrames + 1

      ' // Draw the scene
      DrawScene hwndMain, GL_WINDOWWIDTH, GL_WINDOWHEIGHT
      ' // Exchange the front and back buffers
      SwapBuffers g_hDC

      ' // Process the keystrokes
      IF vKeyCode THEN
         ProcessKeystrokes hwndMain, vKeyCode, bKeyDown
         vKeyCode = 0
      END IF

   LOOP

   FUNCTION = msg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   DIM  pf  AS LONG
   DIM  pfd AS PIXELFORMATDESCRIPTOR
   STATIC hRC AS HGLRC

   SELECT CASE uMsg

      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
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE WM_CREATE
         ' // Retrieve the device context handle
         g_hDC = GetDC(hwnd)

         ' // Fill the PIXELFORMATDESCRIPTOR structure
         pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)   ' Size of the structure
         pfd.nVersion        = 1                               ' Version number
         pfd.dwFlags         = PFD_DRAW_TO_WINDOW _            ' Format must support window
                               OR PFD_SUPPORT_OPENGL _         ' Format must support OpenGL
                               OR PFD_DOUBLEBUFFER             ' Format must support double buffering
         pfd.iPixelType      = PFD_TYPE_RGBA                   ' Request an RGBA format
         pfd.cColorBits      = GL_BITSPERPEL                   ' Number of color bitplanes in each color buffer
         pfd.cRedBits        = 0                               ' Number of red bitplanes in each RGBA color buffer.
         pfd.cRedShift       = 0                               ' Shift count for red bitplanes in each RGBA color buffer.
         pfd.cGreenBits      = 0                               ' Number of green bitplanes in each RGBA color buffer.
         pfd.cGreenShift     = 0                               ' Shift count for green bitplanes in each RGBA color buffer.
         pfd.cBlueBits       = 0                               ' Number of blue bitplanes in each RGBA color buffer.
         pfd.cBlueShift      = 0                               ' Shift count for blue bitplanes in each RGBA color buffer.
         pfd.cAlphaBits      = 0                               ' Number of alpha bitplanes in each RGBA color buffer
         pfd.cAlphaShift     = 0                               ' Shift count for alpha bitplanes in each RGBA color buffer.
         pfd.cAccumBits      = 0                               ' Total number of bitplanes in the accumulation buffer.
         pfd.cAccumRedBits   = 0                               ' Number of red bitplanes in the accumulation buffer.
         pfd.cAccumGreenBits = 0                               ' Number of gree bitplanes in the accumulation buffer.
         pfd.cAccumBlueBits  = 0                               ' Number of blue bitplanes in the accumulation buffer.
         pfd.cAccumAlphaBits = 0                               ' Number of alpha bitplanes in the accumulation buffer.
         pfd.cDepthBits      = GL_DEPTHBITS                    ' Depth of the depth (z-axis) buffer.
         pfd.cStencilBits    = 0                               ' Depth of the stencil buffer.
         pfd.cAuxBuffers     = 0                               ' Number of auxiliary buffers.
         pfd.iLayerType      = 0 ' PFD_MAIN_PLANE              ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.bReserved       = 0                               ' Number of overlay and underlay planes.
         pfd.dwLayerMask     = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.dwVisibleMask   = 0                               ' Transparent color or index of an underlay plane.
         pfd.dwDamageMask    = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.

         ' // Find a matching pixel format
         pf = ChoosePixelFormat(g_hDC, @pfd)
         IF pf = 0 THEN
            MessageBoxW hwnd, "Can't find a suitable pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Set the pixel format
         IF SetPixelFormat(g_hDC, pf, @pfd) = FALSE THEN
            MessageBoxW hwnd, "Can't set the pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Create a new OpenGL rendering context
         hRC = wglCreateContext(g_hDC)
         IF hRC = NULL THEN
            MessageBoxW hwnd, "Can't create an OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Make it current
         IF wglMakeCurrent(g_hDC, hRC) = FALSE THEN
            MessageBoxW hwnd, "Can't activate the OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         EXIT FUNCTION

    CASE WM_DESTROY
         ' // Release the device and rendering contexts
         wglMakeCurrent g_hDC, NULL
         ' // Make the rendering context no longer current
         wglDeleteContext hRC
         ' // Release the device context
         ReleaseDC hwnd, g_hDC
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

      CASE WM_SIZE
         ResizeScene hwnd, LOWORD(lParam), HIWORD(lParam)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

NeHe Lesson 5.


' ########################################################################################
' Microsoft Windows
' File: CW_OGL_Nehe_04
' Contents: CWindow OpenGL - NeHe lesson 5
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
USING Afx

CONST WindowCaption = "NeHe Lesson 5"

CONST GL_WINDOWWIDTH  = 640         ' Window width
CONST GL_WINDOWHEIGHT = 450         ' Window height
CONST GL_BITSPERPEL   = 24          ' Color resolution in bits per pixel
CONST GL_DEPTHBITS    = 32          ' Depth of the depth (z-axis) buffer

DIM SHARED g_hDC AS HDC             ' Device context handle
DIM SHARED rtri AS SINGLE
DIM SHARED rquad AS SINGLE

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declarations
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB ResizeScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB DrawScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
DECLARE SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS HWND, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Specify clear values for the color buffers
   glClearColor 0.0, 0.0, 0.0, 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

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS HWND, 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 45.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 HWND, 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

   glTranslatef -1.5, 0.0, -6.0           ' Move left 1.5 units and into the screen
   glRotatef rtri, 0.0, 1.0, 0.0          ' Rotate the triangle on the Y axis

   glBegin GL_TRIANGLES
      ' Front
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Front)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Left of triangle (Front)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Right of triangle (Front)

      ' Right
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Right)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Left of triangle (Right)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Right of triangle (Right)

      ' Back
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Back)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Left of triangle (Back)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Right of triangle (Back)

      ' Left
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Left)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Left of triangle (Left)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Right of triangle (Left)
   glEnd

   glLoadIdentity
   glTranslatef 1.5, 0.0, -7.0            ' Move right 1.5 units and into the screen
   glRotatef rquad, 1.0, 1.0, 1.0         ' Rotate the quad on the X axis

   glBegin GL_QUADS
      glColor3f   0.0,  1.0,  0.0         ' Set the color to green
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Top)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Top)
      glVertex3f -1.0,  1.0,  1.0         ' Bottom left of the quad (Top)
      glVertex3f  1.0,  1.0,  1.0         ' Bottom right of the quad (Top)

      glColor3f   1.0,  0.5,  0.0         ' Set the color to orange
      glVertex3f  1.0, -1.0,  1.0         ' Top right of the quad (Bottom)
      glVertex3f -1.0, -1.0,  1.0         ' Top left of the quad (Bottom)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Bottom)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Bottom)

      glColor3f   1.0,  0.0,  0.0         ' Set the color to red
      glVertex3f  1.0,  1.0,  1.0         ' Top right of the quad (Front)
      glVertex3f -1.0,  1.0,  1.0         ' Top left of the quad (Front)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom left of the quad (Front)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom right of the quad (Front)

      glColor3f   1.0,  1.0,  0.0         ' Set the color to yellow
      glVertex3f  1.0, -1.0, -1.0         ' Top right of the quad (Back)
      glVertex3f -1.0, -1.0, -1.0         ' Top left of the quad (Back)
      glVertex3f -1.0,  1.0, -1.0         ' Bottom left of the quad (Back)
      glVertex3f  1.0,  1.0, -1.0         ' Bottom right of the quad (Back)

      glColor3f   0.0,  0.0,  1.0         ' Set the color to blue
      glVertex3f -1.0,  1.0,  1.0         ' Top right of the quad (Left)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Left)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Left)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom right of the quad (Left)

      glColor3f   1.0,  0.0,  1.0         ' Set the color to violet
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Right)
      glVertex3f  1.0,  1.0,  1.0         ' Top left of the quad (Right)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom left of the quad (Right)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Right)
   glEnd

   rtri = rtri + 0.2                      ' Increase the rotation variable for the triangle
   rquad = rquad - 0.15                   ' Decrease the rotation variable for the quad

END SUB
' =======================================================================================

' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS HWND, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

   SELECT CASE vKeyCode

      CASE VK_ESCAPE
         ' // Quit if Esc key pressed
         SendMessageW hwnd, WM_CLOSE, 0, 0

   END SELECT

END SUB
' =======================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   ' // Create the window
   DIM hwndMain AS HWND = pWindow.Create(NULL, WindowCaption, @WndProc)
   ' // Don't erase nackground
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Black brush
   pWindow.Brush = CreateSolidBrush(BGR(0, 0, 0))
   ' // Sizes the window by setting the wanted width and height of its client area
   pWindow.SetClientSize(GL_WINDOWWIDTH, GL_WINDOWHEIGHT)
   ' // Centers the window
   pWindow.Center

   ' // Retrieve the coordinates of the window's client area
   DIM rc AS RECT
   GetClientRect hwndMain, @rc
   ' // Initialize the new OpenGL window
   SetupScene hwndMain, rc.Right - rc.Left, rc.Bottom - rc.Top

   ' // Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' // Optional timing code
   DIM t AS DOUBLE
   DIM t0 AS DOUBLE
   DIM fps AS DOUBLE
   DIM nFrames AS LONG
   DIM wszCaption AS WSTRING * 256

   ' // Process Windows messages
   DIM msg AS tagMSG
   DIM bDone AS BOOLEAN
   STATIC vKeyCode AS LONG
   STATIC bKeyDown AS BOOLEAN

   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

      ' // Optional timing code
      ' // 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)
         wszCaption = WindowCaption & " (" & STR(fps) & "FPS)"
         SetWindowTextW hwndMain, @wszCaption
         t0 = t
         nFrames = 0
      END IF
      nFrames = nFrames + 1

      ' // Draw the scene
      DrawScene hwndMain, GL_WINDOWWIDTH, GL_WINDOWHEIGHT
      ' // Exchange the front and back buffers
      SwapBuffers g_hDC

      ' // Process the keystrokes
      IF vKeyCode THEN
         ProcessKeystrokes hwndMain, vKeyCode, bKeyDown
         vKeyCode = 0
      END IF

   LOOP

   FUNCTION = msg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   DIM  pf  AS LONG
   DIM  pfd AS PIXELFORMATDESCRIPTOR
   STATIC hRC AS HGLRC

   SELECT CASE uMsg

      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
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE WM_CREATE
         ' // Retrieve the device context handle
         g_hDC = GetDC(hwnd)

         ' // Fill the PIXELFORMATDESCRIPTOR structure
         pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)   ' Size of the structure
         pfd.nVersion        = 1                               ' Version number
         pfd.dwFlags         = PFD_DRAW_TO_WINDOW _            ' Format must support window
                               OR PFD_SUPPORT_OPENGL _         ' Format must support OpenGL
                               OR PFD_DOUBLEBUFFER             ' Format must support double buffering
         pfd.iPixelType      = PFD_TYPE_RGBA                   ' Request an RGBA format
         pfd.cColorBits      = GL_BITSPERPEL                   ' Number of color bitplanes in each color buffer
         pfd.cRedBits        = 0                               ' Number of red bitplanes in each RGBA color buffer.
         pfd.cRedShift       = 0                               ' Shift count for red bitplanes in each RGBA color buffer.
         pfd.cGreenBits      = 0                               ' Number of green bitplanes in each RGBA color buffer.
         pfd.cGreenShift     = 0                               ' Shift count for green bitplanes in each RGBA color buffer.
         pfd.cBlueBits       = 0                               ' Number of blue bitplanes in each RGBA color buffer.
         pfd.cBlueShift      = 0                               ' Shift count for blue bitplanes in each RGBA color buffer.
         pfd.cAlphaBits      = 0                               ' Number of alpha bitplanes in each RGBA color buffer
         pfd.cAlphaShift     = 0                               ' Shift count for alpha bitplanes in each RGBA color buffer.
         pfd.cAccumBits      = 0                               ' Total number of bitplanes in the accumulation buffer.
         pfd.cAccumRedBits   = 0                               ' Number of red bitplanes in the accumulation buffer.
         pfd.cAccumGreenBits = 0                               ' Number of gree bitplanes in the accumulation buffer.
         pfd.cAccumBlueBits  = 0                               ' Number of blue bitplanes in the accumulation buffer.
         pfd.cAccumAlphaBits = 0                               ' Number of alpha bitplanes in the accumulation buffer.
         pfd.cDepthBits      = GL_DEPTHBITS                    ' Depth of the depth (z-axis) buffer.
         pfd.cStencilBits    = 0                               ' Depth of the stencil buffer.
         pfd.cAuxBuffers     = 0                               ' Number of auxiliary buffers.
         pfd.iLayerType      = 0 ' PFD_MAIN_PLANE              ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.bReserved       = 0                               ' Number of overlay and underlay planes.
         pfd.dwLayerMask     = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.dwVisibleMask   = 0                               ' Transparent color or index of an underlay plane.
         pfd.dwDamageMask    = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.

         ' // Find a matching pixel format
         pf = ChoosePixelFormat(g_hDC, @pfd)
         IF pf = 0 THEN
            MessageBoxW hwnd, "Can't find a suitable pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Set the pixel format
         IF SetPixelFormat(g_hDC, pf, @pfd) = FALSE THEN
            MessageBoxW hwnd, "Can't set the pixel format", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Create a new OpenGL rendering context
         hRC = wglCreateContext(g_hDC)
         IF hRC = NULL THEN
            MessageBoxW hwnd, "Can't create an OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' // Make it current
         IF wglMakeCurrent(g_hDC, hRC) = FALSE THEN
            MessageBoxW hwnd, "Can't activate the OpenGL rendering context", _
                        "Error", MB_OK OR MB_ICONEXCLAMATION
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         EXIT FUNCTION

    CASE WM_DESTROY
         ' // Release the device and rendering contexts
         wglMakeCurrent g_hDC, NULL
         ' // Make the rendering context no longer current
         wglDeleteContext hRC
         ' // Release the device context
         ReleaseDC hwnd, g_hDC
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

      CASE WM_SIZE
         ResizeScene hwnd, LOWORD(lParam), HIWORD(lParam)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

I'm going to add the following functions to AfxGdiPlus.inc. They allow to use textures with OpenGL and are not limited to bitmaps, but can also use .jpg, .png, etc.


' =======================================================================================
' Loads an image from disk an converts it to a texture for use with OpenGL.
' Parameters:
' * wszFileSpec = [in]  The path of the image.
' * TextureWidth = [out] Width of the texture.
' * TextureHeight = [out] Height of the texture.
' * strTextureData = [out] The texture data.
' Return value:
' * ERROR_FILE_NOT_FOUND = File not found.
' * ERROR_INVALID_DATA = Bad image size.
' * A GdiPlus status value.
' =======================================================================================
PRIVATE FUNCTION AfxGdipLoadTexture OVERLOAD (BYREF wszFileName AS WSTRING, BYREF TextureWidth AS LONG, _
   BYREF TextureHeight AS LONG, BYREF strTextureData AS STRING) AS LONG

   DIM pImage AS GpImage PTR, pThumb AS GpImage PTR
   DIM nStatus AS GpStatus, pixColor AS GDIP_BGRA
   DIM pTextureData AS ANY PTR

   ' // Initialize Gdiplus
   DIM token AS ULONG_PTR = AfxGdipInit
   IF token = NULL THEN FUNCTION = 18 : EXIT FUNCTION   ' // GdiplusNotInitialized

   DO
      ' // Load the image from file
      nStatus = GdipLoadImageFromFile(@wszFileName, @pImage)
      IF nStatus <> 0 THEN EXIT DO
      ' // Get the image width and height
      nStatus = GdipGetImageWidth(pImage, @TextureWidth)
      IF nStatus <> 0 THEN EXIT DO
      nStatus = GdipGetImageHeight(pImage, @TextureHeight)
      IF nStatus <> 0 THEN EXIT DO
      IF TextureWidth <> TextureHeight THEN nStatus = ERROR_INVALID_DATA : EXIT DO
      ' // Check if the texture if a power of 2
      DIM nCount AS LONG, nPos AS LONG = 1
      DO
         nPos = INSTR(nPos, BIN(TextureWidth), "1")
         IF nPos = 0 THEN EXIT DO
         nCount += 1
         nPos += 1
      LOOP
      IF nCount <> 1 THEN nStatus = ERROR_INVALID_DATA : EXIT DO
      ' // Get a thumbnail image from the Image object
      nStatus = GdipGetImageThumbnail(pImage, TextureWidth, TextureHeight, @pThumb, NULL, NULL)
      IF nStatus <> 0 THEN EXIT DO
      ' // Flip the image vertically
      nStatus = GdipImageRotateFlip(pThumb, 6) ' 6 = RotateNoneFlipY
      IF nStatus <> 0 THEN EXIT DO
      ' // Fill the strings with nulls
      strTextureData = STRING(TextureWidth * TextureHeight * 4, CHR(0))
      ' // Get a pointer to the beginning of the string buffer
      pTextureData = STRPTR(strTextureData)
      ' // Swap the red and blue colors
      FOR y AS LONG = 0 TO TextureWidth - 1
         FOR x AS LONG = 0 TO TextureHeight - 1
            GdipBitmapGetPixel(cast(GpBitmap PTR, pThumb), x, y, @pixColor.color)
            SWAP pixColor.red, pixColor.blue
            memcpy pTextureData, @pixColor.color, 4
            pTextureData += 4
         NEXT
      NEXT
      EXIT DO
   LOOP

   ' // Free the image
   IF pImage THEN GdipDisposeImage pImage
   ' // Shutdown Gdiplus
   GdiplusShutdown token
   
   FUNCTION = nStatus

END FUNCTION
' =======================================================================================



' =======================================================================================
' Loads an image from a resource file an converts it to a texture for use with OpenGL.
' Parameters:
' * hInstance = [in] The instance handle.
' * wszResourceName = [in] The name of the resource
' * TextureWidth = [out] Width of the texture.
' * TextureHeight = [out] Height of the texture.
' * strTextureData = [out] The texture data.
' Return value:
' * E_POINTER = Invalid pointer.
' * ERROR_FILE_NOT_FOUND = File not found.
' * ERROR_INVALID_DATA = Bad image size.
' * A GdiPlus status value.
' =======================================================================================
PRIVATE FUNCTION AfxGdipLoadTexture OVERLOAD (BYVAL hInstance AS HINSTANCE, _
   BYREF wszResourceName AS WSTRING, BYREF TextureWidth AS LONG, _
   BYREF TextureHeight AS LONG, BYREF strTextureData AS STRING) AS LONG

   DIM pImage AS GpImage PTR, pThumb AS GpImage PTR
   DIM nStatus AS GpStatus, pixColor AS GDIP_BGRA
   DIM pTextureData AS ANY PTR

   DIM hResource     AS HRSRC                 ' // Resource handle
   DIM pResourceData AS ANY PTR               ' // Pointer to the resoruce data
   DIM hGlobal       AS HGLOBAL               ' // Global memory handle
   DIM pGlobalBuffer AS ANY PTR               ' // Pointer to global memory buffer
   DIM pImageStream  AS IStream PTR           ' // IStream interface pointer
   DIM imageSize     AS DWORD                 ' // Image size


   ' // Initialize Gdiplus
   DIM token AS ULONG_PTR = AfxGdipInit
   IF token = NULL THEN FUNCTION = 18 : EXIT FUNCTION   ' // GdiplusNotInitialized

   DO
      ' // Find the resource and lock it
      hResource = FindResourceW(cast(HMODULE, hInstance), @wszResourceName, RT_RCDATA)
      IF hResource = NULL THEN nStatus = E_POINTER : EXIT DO
      imageSize = SizeofResource(cast(HMODULE, hInstance), hResource)
      IF imageSize = 0 THEN nStatus = ERROR_INVALID_DATA : EXIT DO
      pResourceData = LockResource(LoadResource(cast(HMODULE, hInstance), hResource))
      IF pResourceData = NULL THEN nStatus = E_POINTER : EXIT DO
      ' // Allocate memory to hold the image
      hGlobal = GlobalAlloc(GMEM_MOVEABLE, imageSize)
      IF hGlobal = NULL THEN nStatus = E_POINTER : EXIT DO
      ' // Lock the memory
      pGlobalBuffer = GlobalLock(hGlobal)
      IF pGlobalBuffer = NULL THEN nStatus = E_POINTER : EXIT DO
      ' // Copy the image from the resource file to global memory
      memcpy pGlobalBuffer, pResourceData, imageSize
      ' // Create an stream in global memory
      DIM hr AS HRESULT = CreateStreamOnHGlobal(hGlobal, FALSE, @pImageStream)
      IF hr <> S_OK THEN nStatus = hr : EXIT DO
      ' // Create a bitmap from the data contained in the stream
      nStatus = GdipCreateBitmapFromStream(pImageStream, @cast(GpBitmap PTR, pImage))
      IF nStatus <> 0 THEN EXIT DO
      ' // Get the image width and height
      nStatus = GdipGetImageWidth(pImage, @TextureWidth)
      IF nStatus <> 0 THEN EXIT DO
      nStatus = GdipGetImageHeight(pImage, @TextureHeight)
      IF nStatus <> 0 THEN EXIT DO
      IF TextureWidth <> TextureHeight THEN nStatus = ERROR_INVALID_DATA : EXIT DO
      ' // Check if the texture if a power of 2
      DIM nCount AS LONG, nPos AS LONG = 1
      DO
         nPos = INSTR(nPos, BIN(TextureWidth), "1")
         IF nPos = 0 THEN EXIT DO
         nCount += 1
         nPos += 1
      LOOP
      IF nCount <> 1 THEN nStatus = ERROR_INVALID_DATA : EXIT DO
      ' // Get a thumbnail image from the Image object
      nStatus = GdipGetImageThumbnail(pImage, TextureWidth, TextureHeight, @pThumb, NULL, NULL)
      IF nStatus <> 0 THEN EXIT DO
      ' // Flip the image vertically
      nStatus = GdipImageRotateFlip(pThumb, 6) ' 6 = RotateNoneFlipY
      IF nStatus <> 0 THEN EXIT DO
      ' // Fill the strings with nulls
      strTextureData = STRING(TextureWidth * TextureHeight * 4, CHR(0))
      ' // Get a pointer to the beginning of the string buffer
      pTextureData = STRPTR(strTextureData)
      ' // Swap the red and blue colors
      FOR y AS LONG = 0 TO TextureWidth - 1
         FOR x AS LONG = 0 TO TextureHeight - 1
            GdipBitmapGetPixel(cast(GpBitmap PTR, pThumb), x, y, @pixColor.color)
            SWAP pixColor.red, pixColor.blue
            memcpy pTextureData, @pixColor.color, 4
            pTextureData += 4
         NEXT
      NEXT
      EXIT DO
   LOOP

   ' // Release if IStream interface
   IF pImageStream THEN pImageStream->lpvtbl->Release(pImageStream)
   ' // Unlock the memory
   IF pGlobalBuffer THEN GlobalUnlock(pGlobalBuffer)
   ' // Free the global memory
   IF hGlobal THEN GlobalFree(hGlobal)

   ' // Free the image
   IF pImage THEN GdipDisposeImage pImage
   ' // Shutdown Gdiplus
   GdiplusShutdown token
   
   FUNCTION = nStatus

END FUNCTION
' =======================================================================================


José Roca

To test it, I have translated the NeHe example 6, that uses a bitmap for the texture.

The code, the executable and the bitmap can be found in the attached .rar file. Source code not listed here because it exceeds the narrow limit of 20,000 characters of this forum.

José Roca

Because I often have posted translated examples of OpenGL and other graphics technologies, some people have mistankely thought that I'm an expert in them. I know very little about OpenGL and my translations are mainly meant to test the wrappers that I wrote.

José Roca

#9
Instead of the previously posted template, I'm going to use a class. This will avoid the use of global variables.

Will also use a simple timer technique that I learned from Patrice Terrier that allows smooth repainting when resizing.

I'm also going to adapt the glut high level functions to draw teapots, cubes, spheres, etc., to Free Basic. This will free us of having to use a third party dll.

I will also write many examples. Next version will be the OpenGL one.

As soon as I post a new version of the framework, new ideas come to my mind :)


Paul Squires

Quote from: Jose Roca on July 03, 2017, 09:26:26 PM
As soon as I post a new version of the framework, new ideas come to my mind :)

You never stop thinking and coming up with new and exciting code!  :)
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

A new template using a class. These Free Basic classes are very good to encapsulate code nd avoid the use of messing globals. This template makes very easy to use OpenGL, without the need of third party libraries like glut or SDL.

Note that a timer is used to trigger redrawing (a tip learned from Patrice Terrier). This technique keeps CPU usage very low and allows smoother rendering.


' ########################################################################################
' Microsoft Windows
' File: CW_GL_Template.fbtpl
' Contents: CWindow OpenGL Template
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2017 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
USING Afx

CONST GL_WINDOWWIDTH   = 600               ' Window width
CONST GL_WINDOWHEIGHT  = 400               ' Window height
CONST GL_WindowCaption = "NeHe Lesson 5"   ' Window caption

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' =======================================================================================
' OpenGL class
' =======================================================================================
TYPE COGL

   Public:
      m_hDC AS HDC      ' // Device context handle
      m_hRC AS HGLRC    ' // Rendering context handle
      m_hwnd AS HWND    ' // Window handle

   Private:
      rtri AS SINGLE
      rquad AS SINGLE

   Public:
      DECLARE CONSTRUCTOR (BYVAL hwnd AS HWND, BYVAL nBitsPerPel AS LONG = 32, BYVAL cDepthBits AS LONG = 24)
      DECLARE DESTRUCTOR
      DECLARE SUB SetupScene (BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
      DECLARE SUB ResizeScene (BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)
      DECLARE SUB RenderScene
      DECLARE SUB ProcessKeystrokes (BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM)
      DECLARE SUB ProcessMouse (BYVAL uMsg AS UINT, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

END TYPE
' =======================================================================================

' ========================================================================================
' COGL constructor
' ========================================================================================
CONSTRUCTOR COGL (BYVAL hwnd AS HWND, BYVAL nBitsPerPel AS LONG = 32, BYVAL cDepthBits AS LONG = 24)

   DO   ' // Using a fake loop to avoid the use of GOTO or nested IFs/END IFs

      ' // Get the device context
      IF hwnd = NULL THEN EXIT DO
      m_hwnd = hwnd
      m_hDC = GetDC(m_hwnd)
      IF m_hDC = NULL THEN EXIT DO

      ' // Pixel format
      DIM pfd AS PIXELFORMATDESCRIPTOR
      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 = nBitsPerPel
      pfd.cDepthBits = cDepthBits

      ' // Find a matching pixel format
      DIM pf AS LONG = ChoosePixelFormat(m_hDC, @pfd)
      IF pf = 0 THEN
         MessageBoxW hwnd, "Can't find a suitable pixel format", _
                     "Error", MB_OK OR MB_ICONEXCLAMATION
         EXIT DO
      END IF

      ' // Set the pixel format
      IF SetPixelFormat(m_hDC, pf, @pfd) = FALSE THEN
         MessageBoxW hwnd, "Can't set the pixel format", _
                     "Error", MB_OK OR MB_ICONEXCLAMATION
         EXIT DO
      END IF

      ' // Create a new OpenGL rendering context
      m_hRC = wglCreateContext(m_hDC)
      IF m_hRC = NULL THEN
         MessageBoxW hwnd, "Can't create an OpenGL rendering context", _
                     "Error", MB_OK OR MB_ICONEXCLAMATION
         EXIT DO
      END IF

      ' // Make it current
      IF wglMakeCurrent(m_hDC, m_hRC) = FALSE THEN
         MessageBoxW hwnd, "Can't activate the OpenGL rendering context", _
                     "Error", MB_OK OR MB_ICONEXCLAMATION
         EXIT DO
      END IF

      ' // Exit the fake loop
      EXIT DO
   LOOP

END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' COGL Destructor
' ========================================================================================
DESTRUCTOR COGL
   ' // Release the device and rendering contexts
   wglMakeCurrent m_hDC, NULL
   ' // Make the rendering context no longer current
   wglDeleteContext m_hRC
   ' // Release the device context
   ReleaseDC m_hwnd, m_hDC
END DESTRUCTOR
' ========================================================================================

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB COGL.SetupScene (BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' // Specify clear values for the color buffers
   glClearColor 0.0, 0.0, 0.0, 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

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB COGL.ResizeScene (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 45.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 COGL.RenderScene

   ' // Clear the screen buffer
   glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
   ' // Reset the view
   glLoadIdentity

   glTranslatef -1.5, 0.0, -6.0           ' Move left 1.5 units and into the screen
   glRotatef rtri, 0.0, 1.0, 0.0          ' Rotate the triangle on the Y axis

   glBegin GL_TRIANGLES
      ' Front
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Front)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Left of triangle (Front)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Right of triangle (Front)

      ' Right
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Right)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f  1.0, -1.0,  1.0         ' Left of triangle (Right)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Right of triangle (Right)

      ' Back
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Back)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f  1.0, -1.0, -1.0         ' Left of triangle (Back)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Right of triangle (Back)

      ' Left
      glColor3f   1.0,  0.0,  0.0         ' Red
      glVertex3f  0.0,  1.0,  0.0         ' Top of triangle (Left)
      glColor3f   0.0,  0.0,  1.0         ' Blue
      glVertex3f -1.0, -1.0, -1.0         ' Left of triangle (Left)
      glColor3f   0.0,  1.0,  0.0         ' Green
      glVertex3f -1.0, -1.0,  1.0         ' Right of triangle (Left)
   glEnd

   glLoadIdentity
   glTranslatef 1.5, 0.0, -7.0            ' Move right 1.5 units and into the screen
   glRotatef rquad, 1.0, 1.0, 1.0         ' Rotate the quad on the X axis

   glBegin GL_QUADS
      glColor3f   0.0,  1.0,  0.0         ' Set the color to green
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Top)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Top)
      glVertex3f -1.0,  1.0,  1.0         ' Bottom left of the quad (Top)
      glVertex3f  1.0,  1.0,  1.0         ' Bottom right of the quad (Top)

      glColor3f   1.0,  0.5,  0.0         ' Set the color to orange
      glVertex3f  1.0, -1.0,  1.0         ' Top right of the quad (Bottom)
      glVertex3f -1.0, -1.0,  1.0         ' Top left of the quad (Bottom)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Bottom)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Bottom)

      glColor3f   1.0,  0.0,  0.0         ' Set the color to red
      glVertex3f  1.0,  1.0,  1.0         ' Top right of the quad (Front)
      glVertex3f -1.0,  1.0,  1.0         ' Top left of the quad (Front)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom left of the quad (Front)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom right of the quad (Front)

      glColor3f   1.0,  1.0,  0.0         ' Set the color to yellow
      glVertex3f  1.0, -1.0, -1.0         ' Top right of the quad (Back)
      glVertex3f -1.0, -1.0, -1.0         ' Top left of the quad (Back)
      glVertex3f -1.0,  1.0, -1.0         ' Bottom left of the quad (Back)
      glVertex3f  1.0,  1.0, -1.0         ' Bottom right of the quad (Back)

      glColor3f   0.0,  0.0,  1.0         ' Set the color to blue
      glVertex3f -1.0,  1.0,  1.0         ' Top right of the quad (Left)
      glVertex3f -1.0,  1.0, -1.0         ' Top left of the quad (Left)
      glVertex3f -1.0, -1.0, -1.0         ' Bottom left of the quad (Left)
      glVertex3f -1.0, -1.0,  1.0         ' Bottom right of the quad (Left)

      glColor3f   1.0,  0.0,  1.0         ' Set the color to violet
      glVertex3f  1.0,  1.0, -1.0         ' Top right of the quad (Right)
      glVertex3f  1.0,  1.0,  1.0         ' Top left of the quad (Right)
      glVertex3f  1.0, -1.0,  1.0         ' Bottom left of the quad (Right)
      glVertex3f  1.0, -1.0, -1.0         ' Bottom right of the quad (Right)
   glEnd

   rtri = rtri + 0.2                      ' Increase the rotation variable for the triangle
   rquad = rquad - 0.15                   ' Decrease the rotation variable for the quad

   ' // Exchange the front and back buffers
   SwapBuffers m_hdc

END SUB
' =======================================================================================

' =======================================================================================
' Processes keystrokes
' Parameters:
' * uMsg = The Windows message
' * wParam = Additional message information.
' * lParam = Additional message information.
' The contents of the wParam and lParam parameters depend on the value of the uMsg parameter.
' =======================================================================================
SUB COGL.ProcessKeystrokes (BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM)

   SELECT CASE uMsg
      CASE WM_KEYDOWN   ' // A nonsystem key has been pressed
         SELECT CASE LOWORD(wParam)
            CASE VK_ESCAPE
               ' // Send a message to close the application
               SendMessageW m_hwnd, WM_CLOSE, 0, 0
         END SELECT
   END SELECT

END SUB
' =======================================================================================

' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * wMsg      = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
'               MK_CONTROL    The CTRL key is down.
'               MK_LBUTTON    The left mouse button is down.
'               MK_MBUTTON    The middle mouse button is down.
'               MK_RBUTTON    The right mouse button is down.
'               MK_SHIFT      The SHIFT key is down.
'               MK_XBUTTON1   Windows 2000/XP: The first X button is down.
'               MK_XBUTTON2   Windows 2000/XP: The second X button is down.
' * x         = x-coordinate of the cursor
' * y         = y-coordinate of the cursor
' =======================================================================================
SUB COGL.ProcessMouse (BYVAL uMsg AS UINT, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)

   SELECT CASE uMsg

      CASE WM_LBUTTONDOWN   ' // Left mouse button pressed
         ' // Put your code here

      CASE WM_LBUTTONUP   ' // Left mouse button releases
         ' // Put your code here

      CASE WM_MOUSEMOVE   ' // Mouse has been moved
         ' // Put your code here

      END SELECT

END SUB
' =======================================================================================

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   ' // The recommended way is to use a manifest file
   AfxSetProcessDPIAware

   ' // Creates the main window
   DIM pWindow AS CWindow
   ' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
   ' // Create the window
   DIM hwndMain AS HWND = pWindow.Create(NULL, GL_WindowCaption, @WndProc)
   ' // Don't erase the background
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Use a black brush
   pWindow.Brush = CreateSolidBrush(BGR(0, 0, 0))
   ' // Sizes the window by setting the wanted width and height of its client area
   pWindow.SetClientSize(GL_WINDOWWIDTH, GL_WINDOWHEIGHT)
   ' // Centers the window
   pWindow.Center

   ' // Show the window
   ShowWindow hwndMain, nCmdShow
   UpdateWindow hwndMain

   ' // Message loop
   DIM uMsg AS tagMsg
   WHILE GetMessageW(@uMsg, NULL, 0, 0)
      TranslateMessage @uMsg
      DispatchMessageW @uMsg
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   STATIC pCOGL AS COGL PTR   ' // Pointer to the COGL class

   SELECT CASE uMsg

      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
            SendMessageW hwnd, WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE WM_CREATE
         ' // Initialize the new OpenGL window
         pCOGL = NEW COGL(hwnd)
         ' // Retrieve the coordinates of the window's client area
         DIM rc AS RECT
         GetClientRect hwnd, @rc
         ' // Set up the scene
         pCOGL->SetupScene rc.Right - rc.Left, rc.Bottom - rc.Top
         ' // Set the timer (using a timer to trigger redrawing allows a smoother rendering)
         SetTimer(hwnd, 1, 0, NULL)
         EXIT FUNCTION

    CASE WM_DESTROY
         ' // Kill the timer
         KillTimer(hwnd, 1)
         ' // Delete the COGL class
         Delete pCOGL
         ' // Ends the application by sending a WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

      CASE WM_TIMER
         ' // Render the scene
         pCOGL->RenderScene
         EXIT FUNCTION

      CASE WM_SIZE
         pCOGL->ResizeScene LOWORD(lParam), HIWORD(lParam)
         EXIT FUNCTION

      CASE WM_KEYDOWN
         ' // Process keystrokes
         pCOGL->ProcessKeystrokes uMsg, wParam, lParam
         EXIT FUNCTION

      CASE WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE
         ' // Process mouse movements
         pCOGL->ProcessMouse uMsg, wParam, LOWORD(lParam), HIWORD(lParam)

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


José Roca

I have begin to translate the high level glut functions. Tested the torus, cube, sphere and octahedron and got them working. See capture.

José Roca

Almost finished. I have had a hard time with the teapot because Free Basic multidimensional arrays work like C, not as PowerBASIC. Makes it easier to translate C code, but I was not used to it.

José Roca

#14
I have added an update to the first post.

AfxGlut.inc contains the following procedures:

AfxGlutSolidCone / AfxGlutWireCone
AfxGlutSolidCube / AfxGlutWireCube
AfxGlutSolidCylinder / AfxGlutWireCylinder
AfxGlutSolidDodecahedron / AfxGlutWireDodecahedron
AfxGlutSolidIcosahedron / AfxGlutWireIcosahedron
AfxGlutSolidOctahedron / AfxGlutWireOctahedron
AfxGlutSolidRhombicDodecahedron / AfxGlutWireRhombicDodecahedron
AfxGlutSolidSphere / AfxGlutWireSphere
AfxGlutSolidTeapot / AfxGlutWireTeapot
AfxGlutSolidTetrahedron / AfxGlutWireTetrahedron
AfxGlutSolidTorus / AfxGlutWireTorus