Tiko Editor, Nehe 5 example, afxNova
OpenGL test
Hello, I have build in a coordinate system Just for fun. Works all fine Here. No need for using fbgfx library ;-) the Cube rotates with coordinate system.
Must Split the Code example cause Code Editor Had reached its Limit.
' ########################################################################################
' Microsoft Windows
' File: CW_GL_Nehe_05
' Contents: CWindow OpenGL - NeHe lesson 5
' Compiler: FreeBasic 32 & 64 bit
' Translated in 2025 by José 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.
' ########################################################################################
' nehe 5, openGL, Frank bruebach, 07-08-2025, build-in a coordinatesystem
' tiko editor using
'
#define UNICODE
#INCLUDE ONCE "AfxNova/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
USING AfxNova
CONST GL_WINDOWWIDTH = 600 ' Window width
CONST GL_WINDOWHEIGHT = 400 ' Window height
CONST GL_WindowCaption = "NeHe Lesson 5 + Coordinate-System" ' Window caption
DECLARE SUB Coordinatesystem(was AS STRING, TxtPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
DECLARE SUB Object1()
DECLARE SUB movedPoints()
DECLARE FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END wWinMain(GetModuleHandleW(NULL), NULL, wCOMMAND(), 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
' =======================================================================================
' OpenGL class
' =======================================================================================
TYPE COGL
Private:
m_hDC AS HDC ' // Device context handle
m_hRC AS HGLRC ' // Rendering context handle
m_hwnd AS HWND ' // Window handle
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)
DECLARE SUB Cleanup
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
'object1()
Coordinatesystem("", "", 0, 0, 0) ' go
' // 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
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB COGL.Cleanup
' ------------------------------------------------------------------------------------
' Insert your code here
' ------------------------------------------------------------------------------------
END SUB
' =======================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE)
' // 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)
' // Clean resources
pCOGL->Cleanup
' // 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)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
'
Parte two
========================================================================================
SUB movedPoints()
STATIC AS SINGLE page, height, depth
page=page + 0.01
IF page > 3 THEN page = -3 :
glTranslatef page, 0, -6 :
Object1()
END SUB
'-------------------------
SUB Object1()
glBegin GL_POINTS
glVertex3f 1, 1, 0
glVertex3f -1, -1, 0
glEnd
END SUB
SUB Coordinatesystem(was AS STRING, TxtPara AS STRING, Para1 AS SINGLE, Para2 AS SINGLE, Para3 AS SINGLE)
DIM AS INTEGER Zaehler
'glPushMatrix
glBegin GL_LINES:
glColor3f 1.0, 1.0, 1.0 :
FOR Zaehler = 1 TO 6 :
'X-AXES
'
glVertex3f Zaehler+Para1, 0.2+Para2, 0.0+Para3 :
glVertex3f Zaehler+Para1, -0.2+Para2, 0.0+Para3 :
'
glVertex3f Zaehler+Para1, 0.0+Para2, 0.2+Para3 :
glVertex3f Zaehler+Para1, 0.0+Para2, -0.2+Para3 :
'Y-AXES
'
glVertex3f 0.2+Para1, Zaehler+Para2, 0.0+Para3 :
glVertex3f -0.2+Para1, Zaehler+Para2, 0.0+Para3 :
'
glVertex3f 0.0+Para1, Zaehler+Para2, 0.2+Para3 :
glVertex3f 0.0+Para1, Zaehler+Para2, -0.2+Para3 :
'Z-AXES
'
glVertex3f 0.2+Para1, 0.0+Para2, Zaehler+Para3 :
glVertex3f -0.2+Para1, 0.0+Para2, Zaehler+Para3 :
'
glVertex3f 0.0+Para1, 0.2+Para2, Zaehler+Para3 :
glVertex3f 0.0+Para1, -0.2+Para2, Zaehler+Para3 :
NEXT Zaehler
glColor3f 0.0, 0.0, 0.0 :
FOR Zaehler = -6 TO -1 :
'X-AXES
'
glVertex3f Zaehler+Para1, 0.2+Para2, 0.0+Para3 :
glVertex3f Zaehler+Para1, -0.2+Para2, 0.0+Para3 :
'
glVertex3f Zaehler+Para1, 0.0+Para2, 0.2+Para3 :
glVertex3f Zaehler+Para1, 0.0+Para2, -0.2+Para3 :
'Y-AXES
'
glVertex3f 0.2+Para1, Zaehler+Para2, 0.0+Para3 :
glVertex3f -0.2+Para1, Zaehler+Para2, 0.0+Para3 :
'
glVertex3f 0.0+Para1, Zaehler+Para2, 0.2+Para3 :
glVertex3f 0.0+Para1, Zaehler+Para2, -0.2+Para3 :
'Z-AXES
'
glVertex3f 0.2+Para1, 0.0+Para2, Zaehler+Para3 :
glVertex3f -0.2+Para1, 0.0+Para2, Zaehler+Para3 :
'
glVertex3f 0.0+Para1, 0.2+Para2, Zaehler+Para3 :
glVertex3f 0.0+Para1, -0.2+Para2, Zaehler+Para3 :
NEXT Zaehler
' all together axes
'X-AXES
glColor3f 1.0, 0.0, 0.0 :' X = red
glVertex3f -6.0+Para1, 0+Para2, 0+Para3
glVertex3f +6.0+Para1, 0+Para2, 0+Para3
'Y-AXES
glColor3f 0.0, 1.0, 0.0 :' Y = green
glVertex3f 0+Para1, -6.0+Para2, 0+Para3
glVertex3f 0+Para1, +6.0+Para2, 0+Para3
'Z-AXES
glColor3f 0.0, 0.0, 1.0 :' Ze = blue
glVertex3f 0+Para1, 0+Para2, -6.0+Para3
glVertex3f 0+Para1, 0+Para2, +6.0+Para3
glEnd
'glPopMatrix
END SUB
hello again..
afxnova, openGL, tiko editor.
perhaps somebody is interested in.. made a simple coordinate cross and you
can move it by arrows and pageup pagedown key
' freebasic, afxNova, openGL: coordinate cross, moving, 09-08-2025 by frank brubach
' Use ESC key to quit
' PgUp key and PgDn key to Zoom in and out
' UpArrow, DnArrow, RightArrow, Left Arrow to change rotate speed of coordinate cross
#define UNICODE
#INCLUDE ONCE "AfxNova/CWindow.inc"
#INCLUDE ONCE "GL/windows/glu.bi"
#INCLUDE ONCE "AfxNova/AfxGdiplus.inc"
USING AfxNova
CONST GL_WINDOWWIDTH = 800
CONST GL_WINDOWHEIGHT = 600
CONST GL_WindowCaption = "Coordinate cross & moving via arrows"
DECLARE FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwsszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END wWinMain(GetModuleHandleW(NULL), NULL, wCOMMAND(), 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
' =======================================================================================
' OpenGL class
' =======================================================================================
TYPE COGL
Private:
m_hDC AS HDC ' // Device context handle
m_hRC AS HGLRC ' // Rendering context handle
m_hwnd AS HWND ' // Window handle
xrot AS SINGLE
yrot AS SINGLE
zoom AS SINGLE
filter AS LONG
xspeed AS SINGLE
yspeed 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)
DECLARE SUB Cleanup
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
zoom = -5.0
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 0.0, 0.0, zoom
glRotatef xrot, 1.0, 0.0, 0.0
glRotatef yrot, 0.0, 1.0, 0.0
' -- coordinatesystem here included ---------------------------------------------------------
'
dim as integer counter
dim as string TxtPara
dim as single Para1, Para2, Para3
glTranslatef 0.0, 0.0, zoom
glRotatef xrot, 1.0, 0.0, 0.0
glRotatef yrot, 0.0, 1.0, 0.0
'glPushMatrix
glBegin GL_LINES:
glColor3f 1.0, 1.0, 1.0 :
FOR Counter = 1 TO 6 :
'X-AXES
'
glVertex3f counter+Para1, 0.2+Para2, 0.0+Para3 :
glVertex3f counter+Para1, -0.2+Para2, 0.0+Para3 :
'
glVertex3f counter+Para1, 0.0+Para2, 0.2+Para3 :
glVertex3f counter+Para1, 0.0+Para2, -0.2+Para3 :
'Y-AXES
'
glVertex3f 0.2+Para1, counter+Para2, 0.0+Para3 :
glVertex3f -0.2+Para1, counter+Para2, 0.0+Para3 :
'
glVertex3f 0.0+Para1, counter+Para2, 0.2+Para3 :
glVertex3f 0.0+Para1, counter+Para2, -0.2+Para3 :
'Z-AXES
'
glVertex3f 0.2+Para1, 0.0+Para2, counter+Para3 :
glVertex3f -0.2+Para1, 0.0+Para2, counter+Para3 :
'
glVertex3f 0.0+Para1, 0.2+Para2, counter+Para3 :
glVertex3f 0.0+Para1, -0.2+Para2, counter+Para3 :
NEXT counter
glColor3f 0.0, 0.0, 0.0 :
FOR counter = -6 TO -1
'X-AXES
'
glVertex3f counter+Para1, 0.2+Para2, 0.0+Para3 :
glVertex3f counter+Para1, -0.2+Para2, 0.0+Para3 :
'
glVertex3f counter+Para1, 0.0+Para2, 0.2+Para3 :
glVertex3f counter+Para1, 0.0+Para2, -0.2+Para3 :
'Y-AXES
'
glVertex3f 0.2+Para1, counter+Para2, 0.0+Para3 :
glVertex3f -0.2+Para1, counter+Para2, 0.0+Para3 :
'
glVertex3f 0.0+Para1, counter+Para2, 0.2+Para3 :
glVertex3f 0.0+Para1, counter+Para2, -0.2+Para3 :
'Z-AXES
'
glVertex3f 0.2+Para1, 0.0+Para2, counter+Para3 :
glVertex3f -0.2+Para1, 0.0+Para2, counter+Para3 :
'
glVertex3f 0.0+Para1, 0.2+Para2, counter+Para3 :
glVertex3f 0.0+Para1, -0.2+Para2, counter+Para3 :
NEXT counter
' all together axes
'X-AXES
glColor3f 1.0, 0.0, 0.0 :' X = red
glVertex3f -6.0+Para1, 0+Para2, 0+Para3
glVertex3f +6.0+Para1, 0+Para2, 0+Para3
'Y-AXES
glColor3f 0.0, 1.0, 0.0 :' Y = green
glVertex3f 0+Para1, -6.0+Para2, 0+Para3
glVertex3f 0+Para1, +6.0+Para2, 0+Para3
'Z-AXES
glColor3f 0.0, 0.0, 1.0 :' Ze = blue
glVertex3f 0+Para1, 0+Para2, -6.0+Para3
glVertex3f 0+Para1, 0+Para2, +6.0+Para3
glEnd
xrot = xrot + xspeed
yrot = yrot + yspeed
' // Exchange the front and back buffers
SwapBuffers m_hdc
END SUB
' =======================================================================================
' =======================================================================================
SUB COGL.ProcessKeystrokes (BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM)
STATIC AS BOOLEAN lp, fp, light
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
CASE VK_UP
xspeed -= 0.01
CASE VK_DOWN
xspeed += 0.01
CASE VK_LEFT
yspeed -= 0.01
CASE VK_RIGHT
yspeed += 0.01
CASE VK_PRIOR ' // page up
zoom -= 0.02
CASE VK_NEXT ' // page down
zoom += 0.02
END SELECT
END SELECT
END SUB
' =======================================================================================
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
' =======================================================================================
' Cleanup
' =======================================================================================
SUB COGL.Cleanup
END SUB
' =======================================================================================
FUNCTION wWinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL pwszCmdLine AS WSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
SetProcessDpiAwareness(PROCESS_SYSTEM_DPI_AWARE)
' // 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)
' // Clean resources
pCOGL->Cleanup
' // 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)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================