Announcement

Collapse
No announcement yet.

OpenGL Examples

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • #41
    OpenGL: drawf

    Draws the bitmapped letter F on the screen (several times). This demonstrates use of the glBitmap() call.

    Code:
    ' ########################################################################################
    ' Microsoft Windows
    ' File: EX_DDT_OpenGL_drawf.bas
    ' Compilers: PBWIN 10+, PBCC 6+
    ' Headers: Windows API headers 3.0+
    ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
    ' ########################################################################################
    
    '/*
    ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
    ' * ALL RIGHTS RESERVED
    ' * Permission to use, copy, modify, and distribute this software for
    ' * any purpose and without fee is hereby granted, provided that the above
    ' * copyright notice appear in all copies and that both the copyright notice
    ' * and this permission notice appear in supporting documentation, and that
    ' * the name of Silicon Graphics, Inc. not be used in advertising
    ' * or publicity pertaining to distribution of the software without specific,
    ' * written prior permission.
    ' *
    ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
    ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
    ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
    ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
    ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
    ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
    ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
    ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
    ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
    ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
    ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
    ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
    ' *
    ' * US Government Users Restricted Rights
    ' * Use, duplication, or disclosure by the Government is subject to
    ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
    ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
    ' * clause at DFARS 252.227-7013 and/or in similar or successor
    ' * clauses in the FAR or the DOD or NASA FAR Supplement.
    ' * Unpublished-- rights reserved under the copyright laws of the
    ' * United States.  Contractor/manufacturer is Silicon Graphics,
    ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
    ' *
    ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
    ' */
    
    '/*
    ' *  drawf.c
    ' *  Draws the bitmapped letter F on the screen (several times).
    ' *  This demonstrates use of the glBitmap() call.
    ' */
    
    #COMPILE EXE
    #DIM ALL
    
    ' // Include files
    #INCLUDE ONCE "glu.inc"
    
    $WindowCaption = "DDT OpenGL: drawf"
    
    GLOBAL pGL AS IDDTOpenGL
    
    ' =======================================================================================
    ' OpenGL class
    ' =======================================================================================
    CLASS CDDTOpenGL
    
       INSTANCE m_hdc AS DWORD    ' // Device context
       INSTANCE m_hrc AS DWORD    ' // Rendering context
       INSTANCE m_hDlg AS DWORD   ' // Dialog handle
    
       INSTANCE rasters() AS BYTE
    
       CLASS METHOD Destroy
          ' // Release the device and rendering contexts
          IF m_hdc THEN wglMakeCurrent m_hdc, 0
          ' // Delete the rendering context
          IF m_hrc THEN wglDeleteContext m_hrc
          ' // Release the device context
          IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
       END METHOD
    
       ' =====================================================================================
       INTERFACE IDDTOpenGL : INHERIT IUnknown
       ' =====================================================================================
    
       ' =====================================================================================
       ' Initializes OpenGL
       ' =====================================================================================
       METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
    
          IF hDlg = 0 THEN EXIT METHOD
          m_hDlg = hDlg
    
          ' // Get the device context
          m_hdc = GetDC(m_hDlg)
          IF m_hdc = 0 THEN EXIT METHOD
    
          ' // Bits per pixel
          LOCAL nBitsPerPel AS LONG
          nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
    
          ' // Depth bits
          LOCAL cDepthBits AS LONG
          cDepthBits = nBitsPerPel - 8
          IF cDepthBits < 16 THEN cDepthBits = 16
    
          ' // Pixel format
          LOCAL 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
          LOCAL pf AS LONG
          pf = ChoosePixelFormat(m_hdc, pfd)
          IF ISFALSE pf THEN
             MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
             EXIT METHOD
          END IF
    
          ' // Set the pixel format
          IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
             MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
             EXIT METHOD
          END IF
    
          ' // Create a new OpenGL rendering context
          m_hrc = wglCreateContext(m_hdc)
          IF m_hrc = 0 THEN
             MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
             SendMessage m_hDlg, %WM_CLOSE, 0, 0
             EXIT METHOD
          END IF
    
          ' // Make it current
          IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
             MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
             SendMessage m_hDlg, %WM_CLOSE, 0, 0
             EXIT METHOD
          END IF
    
          ' // Return success
          METHOD = %TRUE
    
       END METHOD
       ' =====================================================================================
    
       ' =====================================================================================
       ' All the setup goes here
       ' =====================================================================================
       METHOD SetupScene
    
          REDIM rasters(23) AS INSTANCE BYTE
          ARRAY ASSIGN rasters() = &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, _
          &Hff, &H00, &Hff, &H00, &Hc0, &H00, &Hc0, &H00, &Hc0, &H00, &Hff, &Hc0, &Hff, &Hc0
    
          glPixelStorei %GL_UNPACK_ALIGNMENT, 1
          glClearColor 0.0, 0.0, 0.0, 0.0
    
       END METHOD
       ' =====================================================================================
    
       ' =====================================================================================
       ' Resize the scene
       ' =====================================================================================
       METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
    
          glViewport 0, 0, w, h
          glMatrixMode %GL_PROJECTION
          glLoadIdentity
          glOrtho 0, w, 0, h, -1.0, 1.0
          glMatrixMode %GL_MODELVIEW
    
       END METHOD
       ' =====================================================================================
    
       ' =======================================================================================
       ' Render the scene
       ' =======================================================================================
       METHOD RenderScene
    
          glClear %GL_COLOR_BUFFER_BIT
          glColor3f 1.0, 1.0, 1.0
          glRasterPos2i 20, 20
          glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
          glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
          glBitmap 10, 12, 0.0, 0.0, 11.0, 0.0, rasters(0)
          glFlush
    
          ' // Exchange the front and back buffers
          SwapBuffers m_hdc
    
       END METHOD
       ' =======================================================================================
    
       ' ====================================================================================
       ' Processes keystrokes
       ' ====================================================================================
       METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
          SELECT CASE wMsg
             CASE %WM_KEYDOWN
                SELECT CASE LO(WORD, wParam)
                   CASE %VK_ESCAPE
                      ' // Send a message to close the application
                      DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                END SELECT
          END SELECT
       END METHOD
       ' ====================================================================================
    
       END INTERFACE
    
    END CLASS
    ' =======================================================================================
    
    ' ========================================================================================
    ' Main
    ' ========================================================================================
    FUNCTION PBMAIN () AS LONG
    
       ' // Create the dialog
       LOCAL hDlg AS DWORD
       DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
    
       ' // Create an instance of the DX9 class
       pGL = CLASS "CDDTOpenGL"
       IF ISNOTHING(pGL) THEN EXIT FUNCTION
    
       ' // Initialize OpenGL
       IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
    
       ' // Display and activate the dialog
       DIALOG SHOW MODELESS hDlg, CALL DlgProc
    
       ' // Set the timer
       SetTimer(hDlg, 1, 0, %NULL)
    
       ' // Message loop
       LOCAL uMsg AS tagMsg
       WHILE GetMessage(uMsg, %NULL, 0, 0)
          TranslateMessage uMsg
          DispatchMessage uMsg
       WEND
    
       ' // Kill the timer
       KillTimer(hDlg, 1)
    
    END FUNCTION
    ' ========================================================================================
    
    ' ========================================================================================
    ' Main Dialog procedure
    ' ========================================================================================
    CALLBACK FUNCTION DlgProc() AS LONG
    
       SELECT CASE CB.MSG
    
          CASE %WM_SYSCOMMAND
             ' // Disable the Windows screensaver
             IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
             ' // Close the window
             IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
    
          CASE %WM_INITDIALOG
             ' // Set up the scene
             pGL.SetupScene
    
          CASE %WM_TIMER
             ' // Render the scene
             pGL.RenderScene
    
          CASE %WM_SIZE
             ' // Resize the scene
             pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
    
          CASE %WM_KEYDOWN
             ' // Process keystrokes
             pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
    
          CASE %WM_CLOSE
             ' // Post a message to end the application
             DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
    
          CASE %WM_DESTROY
             ' // End the application
             ' // Use this method instead of DIALOG END with modeless dialogs
             PostQuitMessage 0
    
       END SELECT
    
    END FUNCTION
    ' ========================================================================================
    Attached Files
    Forum: http://www.jose.it-berater.org/smfforum/index.php

    Comment


    • #42
      OpenGL: fog

      This program draws 5 red spheres, each at a different z distance from the eye, in different types of fog. Pressing the f key chooses between 3 types of fog: exponential, exponential squared, and linear. In this program, there is a fixed density value, as well as fixed start and end values for the linear fog.

      Code:
      ' ########################################################################################
      ' Microsoft Windows
      ' File: EX_DDT_OpenGL_fog.bas
      ' Compilers: PBWIN 10+, PBCC 6+
      ' Headers: Windows API headers 3.0+
      ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
      ' ########################################################################################
      
      '/*
      ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
      ' * ALL RIGHTS RESERVED
      ' * Permission to use, copy, modify, and distribute this software for
      ' * any purpose and without fee is hereby granted, provided that the above
      ' * copyright notice appear in all copies and that both the copyright notice
      ' * and this permission notice appear in supporting documentation, and that
      ' * the name of Silicon Graphics, Inc. not be used in advertising
      ' * or publicity pertaining to distribution of the software without specific,
      ' * written prior permission.
      ' *
      ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
      ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
      ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
      ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
      ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
      ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
      ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
      ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
      ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
      ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
      ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
      ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
      ' *
      ' * US Government Users Restricted Rights
      ' * Use, duplication, or disclosure by the Government is subject to
      ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
      ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
      ' * clause at DFARS 252.227-7013 and/or in similar or successor
      ' * clauses in the FAR or the DOD or NASA FAR Supplement.
      ' * Unpublished-- rights reserved under the copyright laws of the
      ' * United States.  Contractor/manufacturer is Silicon Graphics,
      ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
      ' *
      ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
      ' */
      
      '/*
      ' *  fog.c
      ' *  This program draws 5 red spheres, each at a different
      ' *  z distance from the eye, in different types of fog.
      ' *  Pressing the f key chooses between 3 types of
      ' *  fog:  exponential, exponential squared, and linear.
      ' *  In this program, there is a fixed density value, as well
      ' *  as fixed start and end values for the linear fog.
      ' */
      
      #COMPILE EXE
      #DIM ALL
      
      ' // Include files
      #INCLUDE ONCE "glu.inc"
      #INCLUDE ONCE "AfxGlut.inc"
      
      $WindowCaption = "DDT OpenGL: fog"
      
      GLOBAL pGL AS IDDTOpenGL
      
      ' =======================================================================================
      ' OpenGL class
      ' =======================================================================================
      CLASS CDDTOpenGL
      
         INSTANCE m_hdc AS DWORD    ' // Device context
         INSTANCE m_hrc AS DWORD    ' // Rendering context
         INSTANCE m_hDlg AS DWORD   ' // Dialog handle
      
         INSTANCE fogMode AS LONG
      
         CLASS METHOD Destroy
            ' // Release the device and rendering contexts
            IF m_hdc THEN wglMakeCurrent m_hdc, 0
            ' // Delete the rendering context
            IF m_hrc THEN wglDeleteContext m_hrc
            ' // Release the device context
            IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
         END METHOD
      
         ' =====================================================================================
         INTERFACE IDDTOpenGL : INHERIT IUnknown
         ' =====================================================================================
      
         ' =====================================================================================
         ' Initializes OpenGL
         ' =====================================================================================
         METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
      
            IF hDlg = 0 THEN EXIT METHOD
            m_hDlg = hDlg
      
            ' // Get the device context
            m_hdc = GetDC(m_hDlg)
            IF m_hdc = 0 THEN EXIT METHOD
      
            ' // Bits per pixel
            LOCAL nBitsPerPel AS LONG
            nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
      
            ' // Depth bits
            LOCAL cDepthBits AS LONG
            cDepthBits = nBitsPerPel - 8
            IF cDepthBits < 16 THEN cDepthBits = 16
      
            ' // Pixel format
            LOCAL 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
            LOCAL pf AS LONG
            pf = ChoosePixelFormat(m_hdc, pfd)
            IF ISFALSE pf THEN
               MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
               EXIT METHOD
            END IF
      
            ' // Set the pixel format
            IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
               MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
               EXIT METHOD
            END IF
      
            ' // Create a new OpenGL rendering context
            m_hrc = wglCreateContext(m_hdc)
            IF m_hrc = 0 THEN
               MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
               SendMessage m_hDlg, %WM_CLOSE, 0, 0
               EXIT METHOD
            END IF
      
            ' // Make it current
            IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
               MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
               SendMessage m_hDlg, %WM_CLOSE, 0, 0
               EXIT METHOD
            END IF
      
            ' // Return success
            METHOD = %TRUE
      
         END METHOD
         ' =====================================================================================
      
         ' =====================================================================================
         ' All the setup goes here
         ' =====================================================================================
         METHOD SetupScene
      
            DIM position(3) AS SINGLE
            DIM matx(2) AS SINGLE
            DIM fogColor(3) AS SINGLE
      
            ARRAY ASSIGN position() = 0.5, 0.5, 3.0, 0.0
      
            glEnable %GL_DEPTH_TEST
      
            glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
            glEnable %GL_LIGHTING
            glEnable %GL_LIGHT0
               ARRAY ASSIGN matx() = 0.1745, 0.01175, 0.01175
               glMaterialfv %GL_FRONT, %GL_AMBIENT, matx(0)
               matx(0) = 0.61424 : matx(1) = 0.04136 : matx(2) = 0.04136
               glMaterialfv %GL_FRONT, %GL_DIFFUSE, matx(0)
               matx(0) = 0.727811 : matx(1) = 0.626959 : matx(2) = 0.626959
               glMaterialfv %GL_FRONT, %GL_SPECULAR, matx(0)
               glMaterialf %GL_FRONT, %GL_SHININESS, 0.6 * 128.0
      
            glEnable %GL_FOG
               ARRAY ASSIGN fogColor() = 0.5, 0.5, 0.5, 1.0
      
               fogMode = %GL_EXP
               glFogi %GL_FOG_MODE, fogMode
               glFogfv %GL_FOG_COLOR, fogColor(0)
               glFogf %GL_FOG_DENSITY, 0.35
               glHint %GL_FOG_HINT, %GL_DONT_CARE
               glFogf %GL_FOG_START, 1.0
               glFogf %GL_FOG_END, 5.0
      
            glClearColor 0.5, 0.5, 0.5, 1.0  ' /* fog color */
      
         END METHOD
         ' =====================================================================================
      
         ' =====================================================================================
         ' Resize the scene
         ' =====================================================================================
         METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
      
            glViewport 0, 0, w, h
            glMatrixMode %GL_PROJECTION
            glLoadIdentity
            IF w <= h THEN
               glOrtho -2.5, 2.5, -2.5 * h / w, _
                  2.5 * h / w, -10.0, 10.0
            ELSE
               glOrtho -2.5 * w / h, _
                  2.5 * w / h, -2.5, 2.5, -10.0, 10.0
            END IF
            glMatrixMode %GL_MODELVIEW
            glLoadIdentity
      
         END METHOD
         ' =====================================================================================
      
         ' ========================================================================================
         ' Render the sphere
         ' ========================================================================================
         METHOD renderSphere (BYVAL x AS SINGLE, BYVAL y AS SINGLE, BYVAL z AS SINGLE)
      
            glPushMatrix
            glTranslatef x, y, z
            AfxGlutSolidSphere 0.4, 16, 16
            glPopMatrix
      
         END METHOD
         ' ========================================================================================
      
         ' =======================================================================================
         ' Render the scene
         ' =======================================================================================
         METHOD RenderScene
      
            glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
            ME.renderSphere(-2.0, -0.5, -1.0)
            ME.renderSphere(-1.0, -0.5, -2.0)
            ME.renderSphere( 0.0, -0.5, -3.0)
            ME.renderSphere( 1.0, -0.5, -4.0)
            ME.renderSphere( 2.0, -0.5, -5.0)
            glFlush
      
            ' // Exchange the front and back buffers
            SwapBuffers m_hdc
      
         END METHOD
         ' =======================================================================================
      
         ' ====================================================================================
         ' Processes keystrokes
         ' ====================================================================================
         METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
            SELECT CASE wMsg
               CASE %WM_KEYDOWN
                  SELECT CASE LO(WORD, wParam)
                     CASE %VK_ESCAPE
                        ' // Send a message to close the application
                        DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                     CASE %VK_F
                        IF fogMode = %GL_EXP THEN
                           fogMode = %GL_EXP2
                        ELSEIF fogMode = %GL_EXP2 THEN
                           fogMode = %GL_LINEAR
                        ELSEIF fogMode = %GL_LINEAR THEN
                           fogMode = %GL_EXP
                        END IF
                        glFogi %GL_FOG_MODE, fogMode
                  END SELECT
            END SELECT
         END METHOD
         ' ====================================================================================
      
         END INTERFACE
      
      END CLASS
      ' =======================================================================================
      
      ' ========================================================================================
      ' Main
      ' ========================================================================================
      FUNCTION PBMAIN () AS LONG
      
         ' // Create the dialog
         LOCAL hDlg AS DWORD
         DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
      
         ' // Create an instance of the DX9 class
         pGL = CLASS "CDDTOpenGL"
         IF ISNOTHING(pGL) THEN EXIT FUNCTION
      
         ' // Initialize OpenGL
         IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
      
         ' // Display and activate the dialog
         DIALOG SHOW MODELESS hDlg, CALL DlgProc
      
         ' // Set the timer
         SetTimer(hDlg, 1, 0, %NULL)
      
         ' // Message loop
         LOCAL uMsg AS tagMsg
         WHILE GetMessage(uMsg, %NULL, 0, 0)
            TranslateMessage uMsg
            DispatchMessage uMsg
         WEND
      
         ' // Kill the timer
         KillTimer(hDlg, 1)
      
      END FUNCTION
      ' ========================================================================================
      
      ' ========================================================================================
      ' Main Dialog procedure
      ' ========================================================================================
      CALLBACK FUNCTION DlgProc() AS LONG
      
         SELECT CASE CB.MSG
      
            CASE %WM_SYSCOMMAND
               ' // Disable the Windows screensaver
               IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
               ' // Close the window
               IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
      
            CASE %WM_INITDIALOG
               ' // Set up the scene
               pGL.SetupScene
      
            CASE %WM_TIMER
               ' // Render the scene
               pGL.RenderScene
      
            CASE %WM_SIZE
               ' // Resize the scene
               pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
      
            CASE %WM_KEYDOWN
               ' // Process keystrokes
               pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
      
            CASE %WM_CLOSE
               ' // Post a message to end the application
               DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
      
            CASE %WM_DESTROY
               ' // End the application
               ' // Use this method instead of DIALOG END with modeless dialogs
               PostQuitMessage 0
      
         END SELECT
      
      END FUNCTION
      ' ========================================================================================
      Attached Files
      Forum: http://www.jose.it-berater.org/smfforum/index.php

      Comment


      • #43
        OpenGL: light

        This program demonstrates the use of the OpenGL lighting model. A sphere is drawn using a grey material characteristic. A single light source illuminates the object.

        Code:
        ' ########################################################################################
        ' Microsoft Windows
        ' File: EX_DDT_OpenGL_light.bas
        ' Compilers: PBWIN 10+, PBCC 6+
        ' Headers: Windows API headers 3.0+
        ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
        ' ########################################################################################
        
        '/*
        ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
        ' * ALL RIGHTS RESERVED
        ' * Permission to use, copy, modify, and distribute this software for
        ' * any purpose and without fee is hereby granted, provided that the above
        ' * copyright notice appear in all copies and that both the copyright notice
        ' * and this permission notice appear in supporting documentation, and that
        ' * the name of Silicon Graphics, Inc. not be used in advertising
        ' * or publicity pertaining to distribution of the software without specific,
        ' * written prior permission.
        ' *
        ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
        ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
        ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
        ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
        ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
        ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
        ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
        ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
        ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
        ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
        ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
        ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
        ' *
        ' * US Government Users Restricted Rights
        ' * Use, duplication, or disclosure by the Government is subject to
        ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
        ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
        ' * clause at DFARS 252.227-7013 and/or in similar or successor
        ' * clauses in the FAR or the DOD or NASA FAR Supplement.
        ' * Unpublished-- rights reserved under the copyright laws of the
        ' * United States.  Contractor/manufacturer is Silicon Graphics,
        ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
        ' *
        ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
        ' */
        
        '/*
        ' *  light.c
        ' *  This program demonstrates the use of the OpenGL lighting
        ' *  model.  A sphere is drawn using a grey material characteristic.
        ' *  A single light source illuminates the object.
        ' */
        
        #COMPILE EXE
        #DIM ALL
        
        ' // Include files
        #INCLUDE ONCE "glu.inc"
        #INCLUDE ONCE "AfxGlut.inc"
        
        $WindowCaption = "DDT OpenGL: light"
        
        GLOBAL pGL AS IDDTOpenGL
        
        ' =======================================================================================
        ' OpenGL class
        ' =======================================================================================
        CLASS CDDTOpenGL
        
           INSTANCE m_hdc AS DWORD    ' // Device context
           INSTANCE m_hrc AS DWORD    ' // Rendering context
           INSTANCE m_hDlg AS DWORD   ' // Dialog handle
        
           CLASS METHOD Destroy
              ' // Release the device and rendering contexts
              IF m_hdc THEN wglMakeCurrent m_hdc, 0
              ' // Delete the rendering context
              IF m_hrc THEN wglDeleteContext m_hrc
              ' // Release the device context
              IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
           END METHOD
        
           ' =====================================================================================
           INTERFACE IDDTOpenGL : INHERIT IUnknown
           ' =====================================================================================
        
           ' =====================================================================================
           ' Initializes OpenGL
           ' =====================================================================================
           METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
        
              IF hDlg = 0 THEN EXIT METHOD
              m_hDlg = hDlg
        
              ' // Get the device context
              m_hdc = GetDC(m_hDlg)
              IF m_hdc = 0 THEN EXIT METHOD
        
              ' // Bits per pixel
              LOCAL nBitsPerPel AS LONG
              nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
        
              ' // Depth bits
              LOCAL cDepthBits AS LONG
              cDepthBits = nBitsPerPel - 8
              IF cDepthBits < 16 THEN cDepthBits = 16
        
              ' // Pixel format
              LOCAL 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
              LOCAL pf AS LONG
              pf = ChoosePixelFormat(m_hdc, pfd)
              IF ISFALSE pf THEN
                 MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                 EXIT METHOD
              END IF
        
              ' // Set the pixel format
              IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                 MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                 EXIT METHOD
              END IF
        
              ' // Create a new OpenGL rendering context
              m_hrc = wglCreateContext(m_hdc)
              IF m_hrc = 0 THEN
                 MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                 EXIT METHOD
              END IF
        
              ' // Make it current
              IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                 MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                 EXIT METHOD
              END IF
        
              ' // Return success
              METHOD = %TRUE
        
           END METHOD
           ' =====================================================================================
        
           ' =====================================================================================
           ' All the setup goes here
           ' =====================================================================================
           METHOD SetupScene
        
              DIM mat_specular(3) AS SINGLE
              DIM mat_shininess(0) AS SINGLE
              DIM light_position(3) AS SINGLE
        
              ARRAY ASSIGN mat_specular()   = 1.0, 1.0, 1.0, 1.0
              ARRAY ASSIGN mat_shininess()  = 50.0
              ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
        
              glClearColor 0.0, 0.0, 0.0, 0.0
              glShadeModel %GL_SMOOTH
        
              glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
              glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
              glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
        
              glEnable %GL_LIGHTING
              glEnable %GL_LIGHT0
              glEnable %GL_DEPTH_TEST
        
           END METHOD
           ' =====================================================================================
        
           ' =====================================================================================
           ' Resize the scene
           ' =====================================================================================
           METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
        
              glViewport 0, 0, w, h
              glMatrixMode %GL_PROJECTION
              glLoadIdentity
              IF w <= h THEN
                 glOrtho -1.5, 1.5, -1.5 * h / w, _
                    1.5 * h / w, -10.0, 10.0
              ELSE
                 glOrtho -1.5 * w / h, _
                    1.5 * w / h, -1.5, 1.5, -10.0, 10.0
              END IF
              glMatrixMode %GL_MODELVIEW
              glLoadIdentity
        
           END METHOD
           ' =====================================================================================
        
           ' =======================================================================================
           ' Render the scene
           ' =======================================================================================
           METHOD RenderScene
        
              glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
              AfxGlutSolidSphere 1.0, 20, 16
              glFlush
        
              ' // Exchange the front and back buffers
              SwapBuffers m_hdc
        
           END METHOD
           ' =======================================================================================
        
           ' ====================================================================================
           ' Processes keystrokes
           ' ====================================================================================
           METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
              SELECT CASE wMsg
                 CASE %WM_KEYDOWN
                    SELECT CASE LO(WORD, wParam)
                       CASE %VK_ESCAPE
                          ' // Send a message to close the application
                          DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                    END SELECT
              END SELECT
           END METHOD
           ' ====================================================================================
        
           END INTERFACE
        
        END CLASS
        ' =======================================================================================
        
        ' ========================================================================================
        ' Main
        ' ========================================================================================
        FUNCTION PBMAIN () AS LONG
        
           ' // Create the dialog
           LOCAL hDlg AS DWORD
           DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
        
           ' // Create an instance of the DX9 class
           pGL = CLASS "CDDTOpenGL"
           IF ISNOTHING(pGL) THEN EXIT FUNCTION
        
           ' // Initialize OpenGL
           IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
        
           ' // Display and activate the dialog
           DIALOG SHOW MODELESS hDlg, CALL DlgProc
        
           ' // Set the timer
           SetTimer(hDlg, 1, 0, %NULL)
        
           ' // Message loop
           LOCAL uMsg AS tagMsg
           WHILE GetMessage(uMsg, %NULL, 0, 0)
              TranslateMessage uMsg
              DispatchMessage uMsg
           WEND
        
           ' // Kill the timer
           KillTimer(hDlg, 1)
        
        END FUNCTION
        ' ========================================================================================
        
        ' ========================================================================================
        ' Main Dialog procedure
        ' ========================================================================================
        CALLBACK FUNCTION DlgProc() AS LONG
        
           SELECT CASE CB.MSG
        
              CASE %WM_SYSCOMMAND
                 ' // Disable the Windows screensaver
                 IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                 ' // Close the window
                 IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
        
              CASE %WM_INITDIALOG
                 ' // Set up the scene
                 pGL.SetupScene
        
              CASE %WM_TIMER
                 ' // Render the scene
                 pGL.RenderScene
        
              CASE %WM_SIZE
                 ' // Resize the scene
                 pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
        
              CASE %WM_KEYDOWN
                 ' // Process keystrokes
                 pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
        
              CASE %WM_CLOSE
                 ' // Post a message to end the application
                 DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
        
              CASE %WM_DESTROY
                 ' // End the application
                 ' // Use this method instead of DIALOG END with modeless dialogs
                 PostQuitMessage 0
        
           END SELECT
        
        END FUNCTION
        ' ========================================================================================
        Attached Files
        Forum: http://www.jose.it-berater.org/smfforum/index.php

        Comment


        • #44
          OpenGL: lines

          This program demonstrates geometric primitives and their attributes.

          Code:
          ' ########################################################################################
          ' Microsoft Windows
          ' File: EX_DDT_OpenGL_lines.bas
          ' Compilers: PBWIN 10+, PBCC 6+
          ' Headers: Windows API headers 3.0+
          ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
          ' ########################################################################################
          
          '/*
          ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
          ' * ALL RIGHTS RESERVED
          ' * Permission to use, copy, modify, and distribute this software for
          ' * any purpose and without fee is hereby granted, provided that the above
          ' * copyright notice appear in all copies and that both the copyright notice
          ' * and this permission notice appear in supporting documentation, and that
          ' * the name of Silicon Graphics, Inc. not be used in advertising
          ' * or publicity pertaining to distribution of the software without specific,
          ' * written prior permission.
          ' *
          ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
          ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
          ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
          ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
          ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
          ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
          ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
          ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
          ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
          ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
          ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
          ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
          ' *
          ' * US Government Users Restricted Rights
          ' * Use, duplication, or disclosure by the Government is subject to
          ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
          ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
          ' * clause at DFARS 252.227-7013 and/or in similar or successor
          ' * clauses in the FAR or the DOD or NASA FAR Supplement.
          ' * Unpublished-- rights reserved under the copyright laws of the
          ' * United States.  Contractor/manufacturer is Silicon Graphics,
          ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
          ' *
          ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
          ' */
          
          '/*
          ' *  lines.c
          ' *  This program demonstrates geometric primitives and
          ' *  their attributes.
          ' */
          
          #COMPILE EXE
          #DIM ALL
          
          ' // Include files
          #INCLUDE ONCE "glu.inc"
          
          $WindowCaption = "DDT OpenGL: lines"
          
          GLOBAL pGL AS IDDTOpenGL
          
          MACRO drawOneLine(x1,y1,x2,y2)
             glBegin %GL_LINES
             glVertex2f x1, y1
             glVertex2f x2, y2
             glEnd
          END MACRO
          
          ' =======================================================================================
          ' OpenGL class
          ' =======================================================================================
          CLASS CDDTOpenGL
          
             INSTANCE m_hdc AS DWORD    ' // Device context
             INSTANCE m_hrc AS DWORD    ' // Rendering context
             INSTANCE m_hDlg AS DWORD   ' // Dialog handle
          
             CLASS METHOD Destroy
                ' // Release the device and rendering contexts
                IF m_hdc THEN wglMakeCurrent m_hdc, 0
                ' // Delete the rendering context
                IF m_hrc THEN wglDeleteContext m_hrc
                ' // Release the device context
                IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
             END METHOD
          
             ' =====================================================================================
             INTERFACE IDDTOpenGL : INHERIT IUnknown
             ' =====================================================================================
          
             ' =====================================================================================
             ' Initializes OpenGL
             ' =====================================================================================
             METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
          
                IF hDlg = 0 THEN EXIT METHOD
                m_hDlg = hDlg
          
                ' // Get the device context
                m_hdc = GetDC(m_hDlg)
                IF m_hdc = 0 THEN EXIT METHOD
          
                ' // Bits per pixel
                LOCAL nBitsPerPel AS LONG
                nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
          
                ' // Depth bits
                LOCAL cDepthBits AS LONG
                cDepthBits = nBitsPerPel - 8
                IF cDepthBits < 16 THEN cDepthBits = 16
          
                ' // Pixel format
                LOCAL 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
                LOCAL pf AS LONG
                pf = ChoosePixelFormat(m_hdc, pfd)
                IF ISFALSE pf THEN
                   MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                   EXIT METHOD
                END IF
          
                ' // Set the pixel format
                IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                   MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                   EXIT METHOD
                END IF
          
                ' // Create a new OpenGL rendering context
                m_hrc = wglCreateContext(m_hdc)
                IF m_hrc = 0 THEN
                   MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                   SendMessage m_hDlg, %WM_CLOSE, 0, 0
                   EXIT METHOD
                END IF
          
                ' // Make it current
                IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                   MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                   SendMessage m_hDlg, %WM_CLOSE, 0, 0
                   EXIT METHOD
                END IF
          
                ' // Return success
                METHOD = %TRUE
          
             END METHOD
             ' =====================================================================================
          
             ' =====================================================================================
             ' All the setup goes here
             ' =====================================================================================
             METHOD SetupScene
          
                glClearColor 0.0, 0.0, 0.0, 0.0
                glShadeModel %GL_FLAT
          
             END METHOD
             ' =====================================================================================
          
             ' =====================================================================================
             ' Resize the scene
             ' =====================================================================================
             METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
          
                glViewport 0, 0, w, h
                glMatrixMode %GL_PROJECTION
                glLoadIdentity
                gluOrtho2D 0.0, w, 0.0, h
          
             END METHOD
             ' =====================================================================================
          
             ' =======================================================================================
             ' Render the scene
             ' =======================================================================================
             METHOD RenderScene
          
                LOCAL i AS LONG
          
                glClear %GL_COLOR_BUFFER_BIT
          
                ' /* select white for all lines  */
                glColor3f 1.0, 1.0, 1.0
          
                ' /* in 1st row, 3 lines, each with a different stipple  */
                glEnable %GL_LINE_STIPPLE
          
                glLineStipple 1, &H0101  ' /*  dotted  */
                drawOneLine(50.0, 125.0, 150.0, 125.0)
                glLineStipple 1, &H00FF  ' /*  dashed  */
                drawOneLine(150.0, 125.0, 250.0, 125.0)
                glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
                drawOneLine(250.0, 125.0, 350.0, 125.0)
          
                ' /* in 2nd row, 3 wide lines, each with different stipple */
                glLineWidth 5.0
                glLineStipple 1, &H0101  ' /*  dotted  */
                drawOneLine(50.0, 100.0, 150.0, 100.0)
                glLineStipple 1, &H00FF  ' /*  dashed  */
                drawOneLine(150.0, 100.0, 250.0, 100.0)
                glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
                drawOneLine(250.0, 100.0, 350.0, 100.0)
                glLineWidth 1.0
          
                '/* in 3rd row, 6 lines, with dash/dot/dash stipple  */
                '/* as part of a single connected line strip         */
                glLineStipple 1, &H1C47  ' /*  dash/dot/dash  */
                glBegin %GL_LINE_STRIP
                FOR i = 0 TO 6
                   glVertex2f 50.0 + (i * 50.0), 75.0
                NEXT
                glEnd
          
                ' /* in 4th row, 6 independent lines with same stipple  */
                FOR i = 0 TO 5
                   drawOneLine(50.0 + (i * 50.0), 50.0, _
                      50.0 + ((i + 1) * 50.0), 50.0)
                NEXT
          
                '/* in 5th row, 1 line, with dash/dot/dash stipple    */
                '/* and a stipple repeat factor of 5                  */
                glLineStipple 5, &H1C47  ' /*  dash/dot/dash  */
                drawOneLine(50.0, 25.0, 350.0, 25.0)
          
                glDisable %GL_LINE_STIPPLE
                glFlush
          
                ' // Exchange the front and back buffers
                SwapBuffers m_hdc
          
             END METHOD
             ' =======================================================================================
          
             ' ====================================================================================
             ' Processes keystrokes
             ' ====================================================================================
             METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                SELECT CASE wMsg
                   CASE %WM_KEYDOWN
                      SELECT CASE LO(WORD, wParam)
                         CASE %VK_ESCAPE
                            ' // Send a message to close the application
                            DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                      END SELECT
                END SELECT
             END METHOD
             ' ====================================================================================
          
             END INTERFACE
          
          END CLASS
          ' =======================================================================================
          
          ' ========================================================================================
          ' Main
          ' ========================================================================================
          FUNCTION PBMAIN () AS LONG
          
             ' // Create the dialog
             LOCAL hDlg AS DWORD
             DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
          
             ' // Create an instance of the DX9 class
             pGL = CLASS "CDDTOpenGL"
             IF ISNOTHING(pGL) THEN EXIT FUNCTION
          
             ' // Initialize OpenGL
             IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
          
             ' // Display and activate the dialog
             DIALOG SHOW MODELESS hDlg, CALL DlgProc
          
             ' // Set the timer
             SetTimer(hDlg, 1, 0, %NULL)
          
             ' // Message loop
             LOCAL uMsg AS tagMsg
             WHILE GetMessage(uMsg, %NULL, 0, 0)
                TranslateMessage uMsg
                DispatchMessage uMsg
             WEND
          
             ' // Kill the timer
             KillTimer(hDlg, 1)
          
          END FUNCTION
          ' ========================================================================================
          
          ' ========================================================================================
          ' Main Dialog procedure
          ' ========================================================================================
          CALLBACK FUNCTION DlgProc() AS LONG
          
             SELECT CASE CB.MSG
          
                CASE %WM_SYSCOMMAND
                   ' // Disable the Windows screensaver
                   IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                   ' // Close the window
                   IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
          
                CASE %WM_INITDIALOG
                   ' // Set up the scene
                   pGL.SetupScene
          
                CASE %WM_TIMER
                   ' // Render the scene
                   pGL.RenderScene
          
                CASE %WM_SIZE
                   ' // Resize the scene
                   pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
          
                CASE %WM_KEYDOWN
                   ' // Process keystrokes
                   pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
          
                CASE %WM_CLOSE
                   ' // Post a message to end the application
                   DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
          
                CASE %WM_DESTROY
                   ' // End the application
                   ' // Use this method instead of DIALOG END with modeless dialogs
                   PostQuitMessage 0
          
             END SELECT
          
          END FUNCTION
          ' ========================================================================================
          Attached Files
          Forum: http://www.jose.it-berater.org/smfforum/index.php

          Comment


          • #45
            OpenGL: material

            This program demonstrates the use of the GL lighting model. Several objects are drawn using different material characteristics. A single light source illuminates the objects.

            Code:
            ' ########################################################################################
            ' Microsoft Windows
            ' File: EX_DDT_OpenGL_material.bas
            ' Compilers: PBWIN 10+, PBCC 6+
            ' Headers: Windows API headers 3.0+
            ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
            ' ########################################################################################
            
            '/*
            ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
            ' * ALL RIGHTS RESERVED
            ' * Permission to use, copy, modify, and distribute this software for
            ' * any purpose and without fee is hereby granted, provided that the above
            ' * copyright notice appear in all copies and that both the copyright notice
            ' * and this permission notice appear in supporting documentation, and that
            ' * the name of Silicon Graphics, Inc. not be used in advertising
            ' * or publicity pertaining to distribution of the software without specific,
            ' * written prior permission.
            ' *
            ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
            ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
            ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
            ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
            ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
            ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
            ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
            ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
            ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
            ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
            ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
            ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
            ' *
            ' * US Government Users Restricted Rights
            ' * Use, duplication, or disclosure by the Government is subject to
            ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
            ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
            ' * clause at DFARS 252.227-7013 and/or in similar or successor
            ' * clauses in the FAR or the DOD or NASA FAR Supplement.
            ' * Unpublished-- rights reserved under the copyright laws of the
            ' * United States.  Contractor/manufacturer is Silicon Graphics,
            ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
            ' *
            ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
            ' */
            
            '/*
            ' * material.c
            ' * This program demonstrates the use of the GL lighting model.
            ' * Several objects are drawn using different material characteristics.
            ' * A single light source illuminates the objects.
            ' */
            
            #COMPILE EXE
            #DIM ALL
            
            ' // Include files
            #INCLUDE ONCE "glu.inc"
            #INCLUDE ONCE "AfxGlut.inc"
            
            $WindowCaption = "DDT OpenGL: material"
            
            GLOBAL pGL AS IDDTOpenGL
            
            ' =======================================================================================
            ' OpenGL class
            ' =======================================================================================
            CLASS CDDTOpenGL
            
               INSTANCE m_hdc AS DWORD    ' // Device context
               INSTANCE m_hrc AS DWORD    ' // Rendering context
               INSTANCE m_hDlg AS DWORD   ' // Dialog handle
            
               CLASS METHOD Destroy
                  ' // Release the device and rendering contexts
                  IF m_hdc THEN wglMakeCurrent m_hdc, 0
                  ' // Delete the rendering context
                  IF m_hrc THEN wglDeleteContext m_hrc
                  ' // Release the device context
                  IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
               END METHOD
            
               ' =====================================================================================
               INTERFACE IDDTOpenGL : INHERIT IUnknown
               ' =====================================================================================
            
               ' =====================================================================================
               ' Initializes OpenGL
               ' =====================================================================================
               METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
            
                  IF hDlg = 0 THEN EXIT METHOD
                  m_hDlg = hDlg
            
                  ' // Get the device context
                  m_hdc = GetDC(m_hDlg)
                  IF m_hdc = 0 THEN EXIT METHOD
            
                  ' // Bits per pixel
                  LOCAL nBitsPerPel AS LONG
                  nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
            
                  ' // Depth bits
                  LOCAL cDepthBits AS LONG
                  cDepthBits = nBitsPerPel - 8
                  IF cDepthBits < 16 THEN cDepthBits = 16
            
                  ' // Pixel format
                  LOCAL 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
                  LOCAL pf AS LONG
                  pf = ChoosePixelFormat(m_hdc, pfd)
                  IF ISFALSE pf THEN
                     MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                     EXIT METHOD
                  END IF
            
                  ' // Set the pixel format
                  IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                     MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                     EXIT METHOD
                  END IF
            
                  ' // Create a new OpenGL rendering context
                  m_hrc = wglCreateContext(m_hdc)
                  IF m_hrc = 0 THEN
                     MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                     SendMessage m_hDlg, %WM_CLOSE, 0, 0
                     EXIT METHOD
                  END IF
            
                  ' // Make it current
                  IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                     MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                     SendMessage m_hDlg, %WM_CLOSE, 0, 0
                     EXIT METHOD
                  END IF
            
                  ' // Return success
                  METHOD = %TRUE
            
               END METHOD
               ' =====================================================================================
            
               ' =====================================================================================
               ' All the setup goes here
               ' =====================================================================================
               METHOD SetupScene
            
                  DIM ambient(3) AS SINGLE
                  DIM diffuse(3) AS SINGLE
                  DIM specular(3) AS SINGLE
                  DIM position(3) AS SINGLE
                  DIM lmodel_ambient(3) AS SINGLE
                  DIM local_view(0) AS SINGLE
            
                  ARRAY ASSIGN ambient() = 0.0, 0.0, 0.0, 1.0
                  ARRAY ASSIGN diffuse() = 1.0, 1.0, 1.0, 1.0
                  ARRAY ASSIGN specular() = 1.0, 1.0, 1.0, 1.0
                  ARRAY ASSIGN position() = 0.0, 3.0, 2.0, 0.0
                  ARRAY ASSIGN lmodel_ambient() = 0.4, 0.4, 0.4, 1.0
                  ARRAY ASSIGN local_view() = 0.0
            
                  glClearColor 0.0, 0.1, 0.1, 0.0
                  glEnable %GL_DEPTH_TEST
                  glShadeModel %GL_SMOOTH
            
                  glLightfv %GL_LIGHT0, %GL_AMBIENT, ambient(0)
                  glLightfv %GL_LIGHT0, %GL_DIFFUSE, diffuse(0)
                  glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
                  glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lmodel_ambient(0)
                  glLightModelfv %GL_LIGHT_MODEL_LOCAL_VIEWER, local_view(0)
            
                  glEnable %GL_LIGHTING
                  glEnable %GL_LIGHT0
            
               END METHOD
               ' =====================================================================================
            
               ' =====================================================================================
               ' Resize the scene
               ' =====================================================================================
               METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
            
                  glViewport 0, 0, w, h
                  glMatrixMode %GL_PROJECTION
                  glLoadIdentity
                  IF w <= (h * 2) THEN
                     glOrtho -6.0, 6.0, -3.0 * (h * 2) / w, _
                        3.0 * (h * 2) / w, -10.0, 10.0
                  ELSE
                     glOrtho -6.0 * w / (h * 2), _
                        6.0 * w / (h * 2), -3.0, 3.0, -10.0, 10.0
                  END IF
                  glMatrixMode %GL_MODELVIEW
                  glLoadIdentity
            
               END METHOD
               ' =====================================================================================
            
               ' =======================================================================================
               ' Render the scene
               ' =======================================================================================
               METHOD RenderScene
            
                  DIM no_mat(3) AS SINGLE
                  DIM mat_ambient(3) AS SINGLE
                  DIM mat_ambient_color(3) AS SINGLE
                  DIM mat_diffuse(3) AS SINGLE
                  DIM mat_specular(3) AS SINGLE
                  DIM no_shininess(0) AS SINGLE
                  DIM low_shininess(0) AS SINGLE
                  DIM high_shininess(0) AS SINGLE
                  DIM mat_emission(3) AS SINGLE
            
                  ARRAY ASSIGN no_mat() = 0.0, 0.0, 0.0, 1.0
                  ARRAY ASSIGN mat_ambient() = 0.7, 0.7, 0.7, 1.0
                  ARRAY ASSIGN mat_ambient_color() = 0.8, 0.8, 0.2, 1.0
                  ARRAY ASSIGN mat_diffuse() = 0.1, 0.5, 0.8, 1.0
                  ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
                  ARRAY ASSIGN no_shininess() = 0.0
                  ARRAY ASSIGN low_shininess() = 5.0
                  ARRAY ASSIGN high_shininess() = 100.0
                  ARRAY ASSIGN mat_emission() = 0.3, 0.2, 0.2, 0.0
            
                  glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
            
                  '/*  draw sphere in first row, first column
                  ' *  diffuse reflection only; no ambient or specular
                  ' */
                  glPushMatrix
                  glTranslatef -3.75, 3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in first row, second column
                  ' *  diffuse and specular reflection; low shininess; no ambient
                  ' */
                  glPushMatrix
                  glTranslatef -1.25, 3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in first row, third column
                  ' *  diffuse and specular reflection; high shininess; no ambient
                  ' */
                  glPushMatrix
                  glTranslatef 1.25, 3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in first row, fourth column
                  ' *  diffuse reflection; emission; no ambient or specular reflection
                  ' */
                  glPushMatrix
                  glTranslatef 3.75, 3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in second row, first column
                  ' *  ambient and diffuse reflection; no specular
                  ' */
                  glPushMatrix
                  glTranslatef -3.75, 0.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in second row, second column
                  ' *  ambient, diffuse and specular reflection; low shininess
                  ' */
                  glPushMatrix
                  glTranslatef -1.25, 0.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in second row, third column
                  ' *  ambient, diffuse and specular reflection; high shininess
                  ' */
                  glPushMatrix
                  glTranslatef 1.25, 0.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in second row, fourth column
                  ' *  ambient and diffuse reflection; emission; no specular
                  ' */
                  glPushMatrix
                  glTranslatef 3.75, 0.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in third row, first column
                  ' *  colored ambient and diffuse reflection; no specular
                  ' */
                  glPushMatrix
                  glTranslatef -3.75, -3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in third row, second column
                  ' *  colored ambient, diffuse and specular reflection; low shininess
                  ' */
                  glPushMatrix
                  glTranslatef -1.25, -3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, low_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in third row, third column
                  ' *  colored ambient, diffuse and specular reflection; high shininess
                  ' */
                  glPushMatrix
                  glTranslatef 1.25, -3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, high_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, no_mat(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  '/*  draw sphere in third row, fourth column
                  ' *  colored ambient and diffuse reflection; emission; no specular
                  ' */
                  glPushMatrix
                  glTranslatef 3.75, -3.0, 0.0
                  glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient_color(0)
                  glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                  glMaterialfv %GL_FRONT, %GL_SPECULAR, no_mat(0)
                  glMaterialfv %GL_FRONT, %GL_SHININESS, no_shininess(0)
                  glMaterialfv %GL_FRONT, %GL_EMISSION, mat_emission(0)
                  AfxGlutSolidSphere 1.0, 16, 16
                  glPopMatrix
            
                  glFlush
            
                  ' // Exchange the front and back buffers
                  SwapBuffers m_hdc
            
               END METHOD
               ' =======================================================================================
            
               ' ====================================================================================
               ' Processes keystrokes
               ' ====================================================================================
               METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                  SELECT CASE wMsg
                     CASE %WM_KEYDOWN
                        SELECT CASE LO(WORD, wParam)
                           CASE %VK_ESCAPE
                              ' // Send a message to close the application
                              DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                        END SELECT
                  END SELECT
               END METHOD
               ' ====================================================================================
            
               END INTERFACE
            
            END CLASS
            ' =======================================================================================
            
            ' ========================================================================================
            ' Main
            ' ========================================================================================
            FUNCTION PBMAIN () AS LONG
            
               ' // Create the dialog
               LOCAL hDlg AS DWORD
               DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 420, %WS_OVERLAPPEDWINDOW TO hDlg
            
               ' // Create an instance of the DX9 class
               pGL = CLASS "CDDTOpenGL"
               IF ISNOTHING(pGL) THEN EXIT FUNCTION
            
               ' // Initialize OpenGL
               IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
            
               ' // Display and activate the dialog
               DIALOG SHOW MODELESS hDlg, CALL DlgProc
            
               ' // Set the timer
               SetTimer(hDlg, 1, 0, %NULL)
            
               ' // Message loop
               LOCAL uMsg AS tagMsg
               WHILE GetMessage(uMsg, %NULL, 0, 0)
                  TranslateMessage uMsg
                  DispatchMessage uMsg
               WEND
            
               ' // Kill the timer
               KillTimer(hDlg, 1)
            
            END FUNCTION
            ' ========================================================================================
            
            ' ========================================================================================
            ' Main Dialog procedure
            ' ========================================================================================
            CALLBACK FUNCTION DlgProc() AS LONG
            
               SELECT CASE CB.MSG
            
                  CASE %WM_SYSCOMMAND
                     ' // Disable the Windows screensaver
                     IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                     ' // Close the window
                     IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
            
                  CASE %WM_INITDIALOG
                     ' // Set up the scene
                     pGL.SetupScene
            
                  CASE %WM_TIMER
                     ' // Render the scene
                     pGL.RenderScene
            
                  CASE %WM_SIZE
                     ' // Resize the scene
                     pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
            
                  CASE %WM_KEYDOWN
                     ' // Process keystrokes
                     pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
            
                  CASE %WM_CLOSE
                     ' // Post a message to end the application
                     DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
            
                  CASE %WM_DESTROY
                     ' // End the application
                     ' // Use this method instead of DIALOG END with modeless dialogs
                     PostQuitMessage 0
            
               END SELECT
            
            END FUNCTION
            ' ========================================================================================
            Attached Files
            Forum: http://www.jose.it-berater.org/smfforum/index.php

            Comment


            • #46
              OpenGL: model

              This program demonstrates modeling transformations

              Code:
              ' ########################################################################################
              ' Microsoft Windows
              ' File: EX_DDT_OpenGL_model.bas
              ' Compilers: PBWIN 10+, PBCC 6+
              ' Headers: Windows API headers 3.0+
              ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
              ' ########################################################################################
              
              '/*
              ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
              ' * ALL RIGHTS RESERVED
              ' * Permission to use, copy, modify, and distribute this software for
              ' * any purpose and without fee is hereby granted, provided that the above
              ' * copyright notice appear in all copies and that both the copyright notice
              ' * and this permission notice appear in supporting documentation, and that
              ' * the name of Silicon Graphics, Inc. not be used in advertising
              ' * or publicity pertaining to distribution of the software without specific,
              ' * written prior permission.
              ' *
              ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
              ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
              ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
              ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
              ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
              ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
              ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
              ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
              ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
              ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
              ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
              ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
              ' *
              ' * US Government Users Restricted Rights
              ' * Use, duplication, or disclosure by the Government is subject to
              ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
              ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
              ' * clause at DFARS 252.227-7013 and/or in similar or successor
              ' * clauses in the FAR or the DOD or NASA FAR Supplement.
              ' * Unpublished-- rights reserved under the copyright laws of the
              ' * United States.  Contractor/manufacturer is Silicon Graphics,
              ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
              ' *
              ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
              ' */
              
              '/*
              ' *  model.c
              ' *  This program demonstrates modeling transformations
              ' */
              
              #COMPILE EXE
              #DIM ALL
              
              ' // Include files
              #INCLUDE ONCE "glu.inc"
              
              $WindowCaption = "DDT OpenGL: model"
              
              GLOBAL pGL AS IDDTOpenGL
              
              ' =======================================================================================
              ' OpenGL class
              ' =======================================================================================
              CLASS CDDTOpenGL
              
                 INSTANCE m_hdc AS DWORD    ' // Device context
                 INSTANCE m_hrc AS DWORD    ' // Rendering context
                 INSTANCE m_hDlg AS DWORD   ' // Dialog handle
              
                 CLASS METHOD Destroy
                    ' // Release the device and rendering contexts
                    IF m_hdc THEN wglMakeCurrent m_hdc, 0
                    ' // Delete the rendering context
                    IF m_hrc THEN wglDeleteContext m_hrc
                    ' // Release the device context
                    IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                 END METHOD
              
                 ' =====================================================================================
                 INTERFACE IDDTOpenGL : INHERIT IUnknown
                 ' =====================================================================================
              
                 ' =====================================================================================
                 ' Initializes OpenGL
                 ' =====================================================================================
                 METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
              
                    IF hDlg = 0 THEN EXIT METHOD
                    m_hDlg = hDlg
              
                    ' // Get the device context
                    m_hdc = GetDC(m_hDlg)
                    IF m_hdc = 0 THEN EXIT METHOD
              
                    ' // Bits per pixel
                    LOCAL nBitsPerPel AS LONG
                    nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
              
                    ' // Depth bits
                    LOCAL cDepthBits AS LONG
                    cDepthBits = nBitsPerPel - 8
                    IF cDepthBits < 16 THEN cDepthBits = 16
              
                    ' // Pixel format
                    LOCAL 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
                    LOCAL pf AS LONG
                    pf = ChoosePixelFormat(m_hdc, pfd)
                    IF ISFALSE pf THEN
                       MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                       EXIT METHOD
                    END IF
              
                    ' // Set the pixel format
                    IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                       MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                       EXIT METHOD
                    END IF
              
                    ' // Create a new OpenGL rendering context
                    m_hrc = wglCreateContext(m_hdc)
                    IF m_hrc = 0 THEN
                       MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                       SendMessage m_hDlg, %WM_CLOSE, 0, 0
                       EXIT METHOD
                    END IF
              
                    ' // Make it current
                    IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                       MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                       SendMessage m_hDlg, %WM_CLOSE, 0, 0
                       EXIT METHOD
                    END IF
              
                    ' // Return success
                    METHOD = %TRUE
              
                 END METHOD
                 ' =====================================================================================
              
                 ' =====================================================================================
                 ' All the setup goes here
                 ' =====================================================================================
                 METHOD SetupScene
              
                    glClearColor 0.0, 0.0, 0.0, 0.0
                    glShadeModel %GL_FLAT
              
                 END METHOD
                 ' =====================================================================================
              
                 ' =====================================================================================
                 ' Resize the scene
                 ' =====================================================================================
                 METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
              
                    glViewport 0, 0, w, h
                    glMatrixMode %GL_PROJECTION
                    glLoadIdentity
                    IF w <= h THEN
                       glOrtho -50.0, 50.0, -50.0 * h / w, _
                          50.0 * h / w, -1.0, 1.0
                    ELSE
                       glOrtho -50.0 * w / h, _
                          50.0 * w / h, -50.0, 50.0, -1.0, 1.0
                    END IF
                    glMatrixMode %GL_MODELVIEW
              
                 END METHOD
                 ' =====================================================================================
              
                 ' =====================================================================================
                 METHOD draw_triangle()
              
                    glBegin %GL_LINE_LOOP
                    glVertex2f 0.0, 25.0
                    glVertex2f 25.0, -25.0
                    glVertex2f -25.0, -25.0
                    glEnd
              
                 END METHOD
                 ' =====================================================================================
              
                 ' =======================================================================================
                 ' Render the scene
                 ' =======================================================================================
                 METHOD RenderScene
              
                    glClear %GL_COLOR_BUFFER_BIT
                    glColor3f 1.0, 1.0, 1.0
              
                    glLoadIdentity
                    glColor3f 1.0, 1.0, 1.0
                    ME.draw_triangle
              
                    glEnable %GL_LINE_STIPPLE
                    glLineStipple 1, &HF0F0
                    glLoadIdentity
                    glTranslatef -20.0, 0.0, 0.0
                    ME.draw_triangle
              
                    glLineStipple 1, &HF00F
                    glLoadIdentity
                    glScalef 1.5, 0.5, 1.0
                    ME.draw_triangle
              
                    glLineStipple 1, &H8888
                    glLoadIdentity
                    glRotatef 90.0, 0.0, 0.0, 1.0
                    ME.draw_triangle
                    glDisable %GL_LINE_STIPPLE
              
                    glFlush
              
                    ' // Exchange the front and back buffers
                    SwapBuffers m_hdc
              
                 END METHOD
                 ' =======================================================================================
              
                 ' ====================================================================================
                 ' Processes keystrokes
                 ' ====================================================================================
                 METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                    SELECT CASE wMsg
                       CASE %WM_KEYDOWN
                          SELECT CASE LO(WORD, wParam)
                             CASE %VK_ESCAPE
                                ' // Send a message to close the application
                                DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                          END SELECT
                    END SELECT
                 END METHOD
                 ' ====================================================================================
              
                 END INTERFACE
              
              END CLASS
              ' =======================================================================================
              
              ' ========================================================================================
              ' Main
              ' ========================================================================================
              FUNCTION PBMAIN () AS LONG
              
                 ' // Create the dialog
                 LOCAL hDlg AS DWORD
                 DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
              
                 ' // Create an instance of the DX9 class
                 pGL = CLASS "CDDTOpenGL"
                 IF ISNOTHING(pGL) THEN EXIT FUNCTION
              
                 ' // Initialize OpenGL
                 IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
              
                 ' // Display and activate the dialog
                 DIALOG SHOW MODELESS hDlg, CALL DlgProc
              
                 ' // Set the timer
                 SetTimer(hDlg, 1, 0, %NULL)
              
                 ' // Message loop
                 LOCAL uMsg AS tagMsg
                 WHILE GetMessage(uMsg, %NULL, 0, 0)
                    TranslateMessage uMsg
                    DispatchMessage uMsg
                 WEND
              
                 ' // Kill the timer
                 KillTimer(hDlg, 1)
              
              END FUNCTION
              ' ========================================================================================
              
              ' ========================================================================================
              ' Main Dialog procedure
              ' ========================================================================================
              CALLBACK FUNCTION DlgProc() AS LONG
              
                 SELECT CASE CB.MSG
              
                    CASE %WM_SYSCOMMAND
                       ' // Disable the Windows screensaver
                       IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                       ' // Close the window
                       IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
              
                    CASE %WM_INITDIALOG
                       ' // Set up the scene
                       pGL.SetupScene
              
                    CASE %WM_TIMER
                       ' // Render the scene
                       pGL.RenderScene
              
                    CASE %WM_SIZE
                       ' // Resize the scene
                       pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
              
                    CASE %WM_KEYDOWN
                       ' // Process keystrokes
                       pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
              
                    CASE %WM_CLOSE
                       ' // Post a message to end the application
                       DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
              
                    CASE %WM_DESTROY
                       ' // End the application
                       ' // Use this method instead of DIALOG END with modeless dialogs
                       PostQuitMessage 0
              
                 END SELECT
              
              END FUNCTION
              ' ========================================================================================
              Attached Files
              Forum: http://www.jose.it-berater.org/smfforum/index.php

              Comment


              • #47
                OpenGL: movelight

                This program demonstrates when to issue lighting and transformation commands to render a model with a light which is moved by a modeling transformation (rotate or translate). The light position is reset after the modeling transformation is called. The eye position does not change.

                A sphere is drawn using a grey material characteristic.
                A single light source illuminates the object.

                Interaction: pressing the left mouse button alters the modeling transformation (x rotation) by 30 degrees. The scene is then redrawn with the light in a new position.

                Code:
                ' ########################################################################################
                ' Microsoft Windows
                ' File: EX_DDT_OpenGL_movelight.bas
                ' Compilers: PBWIN 10+, PBCC 6+
                ' Headers: Windows API headers 3.0+
                ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                ' ########################################################################################
                
                '/*
                ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                ' * ALL RIGHTS RESERVED
                ' * Permission to use, copy, modify, and distribute this software for
                ' * any purpose and without fee is hereby granted, provided that the above
                ' * copyright notice appear in all copies and that both the copyright notice
                ' * and this permission notice appear in supporting documentation, and that
                ' * the name of Silicon Graphics, Inc. not be used in advertising
                ' * or publicity pertaining to distribution of the software without specific,
                ' * written prior permission.
                ' *
                ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                ' *
                ' * US Government Users Restricted Rights
                ' * Use, duplication, or disclosure by the Government is subject to
                ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                ' * clause at DFARS 252.227-7013 and/or in similar or successor
                ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                ' * Unpublished-- rights reserved under the copyright laws of the
                ' * United States.  Contractor/manufacturer is Silicon Graphics,
                ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                ' *
                ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                ' */
                
                '/*
                ' *  movelight.c
                ' *  This program demonstrates when to issue lighting and
                ' *  transformation commands to render a model with a light
                ' *  which is moved by a modeling transformation (rotate or
                ' *  translate).  The light position is reset after the modeling
                ' *  transformation is called.  The eye position does not change.
                ' *
                ' *  A sphere is drawn using a grey material characteristic.
                ' *  A single light source illuminates the object.
                ' *
                ' *  Interaction:  pressing the left mouse button alters
                ' *  the modeling transformation (x rotation) by 30 degrees.
                ' *  The scene is then redrawn with the light in a new position.
                ' */
                
                #COMPILE EXE
                #DIM ALL
                
                ' // Include files
                #INCLUDE ONCE "glu.inc"
                #INCLUDE ONCE "AfxGlut.inc"
                
                $WindowCaption = "DDT OpenGL: movelight"
                
                GLOBAL pGL AS IDDTOpenGL
                
                ' =======================================================================================
                ' OpenGL class
                ' =======================================================================================
                CLASS CDDTOpenGL
                
                   INSTANCE m_hdc AS DWORD    ' // Device context
                   INSTANCE m_hrc AS DWORD    ' // Rendering context
                   INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                
                   INSTANCE spin AS LONG
                
                   CLASS METHOD Destroy
                      ' // Release the device and rendering contexts
                      IF m_hdc THEN wglMakeCurrent m_hdc, 0
                      ' // Delete the rendering context
                      IF m_hrc THEN wglDeleteContext m_hrc
                      ' // Release the device context
                      IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                   END METHOD
                
                   ' =====================================================================================
                   INTERFACE IDDTOpenGL : INHERIT IUnknown
                   ' =====================================================================================
                
                   ' =====================================================================================
                   ' Initializes OpenGL
                   ' =====================================================================================
                   METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                
                      IF hDlg = 0 THEN EXIT METHOD
                      m_hDlg = hDlg
                
                      ' // Get the device context
                      m_hdc = GetDC(m_hDlg)
                      IF m_hdc = 0 THEN EXIT METHOD
                
                      ' // Bits per pixel
                      LOCAL nBitsPerPel AS LONG
                      nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                
                      ' // Depth bits
                      LOCAL cDepthBits AS LONG
                      cDepthBits = nBitsPerPel - 8
                      IF cDepthBits < 16 THEN cDepthBits = 16
                
                      ' // Pixel format
                      LOCAL 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
                      LOCAL pf AS LONG
                      pf = ChoosePixelFormat(m_hdc, pfd)
                      IF ISFALSE pf THEN
                         MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                         EXIT METHOD
                      END IF
                
                      ' // Set the pixel format
                      IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                         MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                         EXIT METHOD
                      END IF
                
                      ' // Create a new OpenGL rendering context
                      m_hrc = wglCreateContext(m_hdc)
                      IF m_hrc = 0 THEN
                         MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                         SendMessage m_hDlg, %WM_CLOSE, 0, 0
                         EXIT METHOD
                      END IF
                
                      ' // Make it current
                      IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                         MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                         SendMessage m_hDlg, %WM_CLOSE, 0, 0
                         EXIT METHOD
                      END IF
                
                      ' // Return success
                      METHOD = %TRUE
                
                   END METHOD
                   ' =====================================================================================
                
                   ' =====================================================================================
                   ' All the setup goes here
                   ' =====================================================================================
                   METHOD SetupScene
                
                      glClearColor 0.0, 0.0, 0.0, 0.0
                      glShadeModel %GL_SMOOTH
                      glEnable %GL_LIGHTING
                      glEnable %GL_LIGHT0
                      glEnable %GL_DEPTH_TEST
                
                   END METHOD
                   ' =====================================================================================
                
                   ' =====================================================================================
                   ' Resize the scene
                   ' =====================================================================================
                   METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                
                      glViewport 0, 0, w, h
                      glMatrixMode %GL_PROJECTION
                      glLoadIdentity
                      gluPerspective 40.0, w / h, 1.0, 20.0
                      glMatrixMode %GL_MODELVIEW
                      glLoadIdentity
                
                   END METHOD
                   ' =====================================================================================
                
                   ' =======================================================================================
                   ' Render the scene
                   '/*  Here is where the light position is reset after the modeling
                   ' *  transformation (glRotated) is called.  This places the
                   ' *  light at a new position in world coordinates.  The cube
                   ' *  represents the position of the light.
                ' */
                   ' =======================================================================================
                   METHOD RenderScene
                
                      DIM position(3) AS SINGLE
                
                      ARRAY ASSIGN position() = 0.0, 0.0, 1.5, 1.0
                
                      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                      glPushMatrix
                      gluLookAt 0.0, 0.0, 5.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0
                
                      glPushMatrix
                      glRotated spin, 1.0, 0.0, 0.0
                      glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
                
                      glTranslated 0.0, 0.0, 1.5
                      glDisable %GL_LIGHTING
                      glColor3f 0.0, 1.0, 1.0
                      AfxGlutWireCube 0.1
                      glEnable %GL_LIGHTING
                      glPopMatrix
                
                      AfxGlutSolidTorus 0.275, 0.85, 8, 15
                      glPopMatrix
                      glFlush
                
                      ' // Exchange the front and back buffers
                      SwapBuffers m_hdc
                
                   END METHOD
                   ' =======================================================================================
                
                   ' ====================================================================================
                   ' Processes keystrokes
                   ' ====================================================================================
                   METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                      SELECT CASE wMsg
                         CASE %WM_KEYDOWN
                            SELECT CASE LO(WORD, wParam)
                               CASE %VK_ESCAPE
                                  ' // Send a message to close the application
                                  DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                            END SELECT
                      END SELECT
                   END METHOD
                   ' ====================================================================================
                
                   ' ====================================================================================
                   ' Processes mouse clicks and movement
                   ' Parameters:
                   ' * hDlg      = Dialog hande
                   ' * 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
                   ' ====================================================================================
                   METHOD ProcessMouse (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)
                
                      SELECT CASE wMsg
                         CASE %WM_LBUTTONDOWN
                            spin = (spin + 30) MOD 360
                      END SELECT
                
                   END METHOD
                   ' ====================================================================================
                
                   END INTERFACE
                
                END CLASS
                ' =======================================================================================
                
                ' ========================================================================================
                ' Main
                ' ========================================================================================
                FUNCTION PBMAIN () AS LONG
                
                   ' // Create the dialog
                   LOCAL hDlg AS DWORD
                   DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                
                   ' // Create an instance of the DX9 class
                   pGL = CLASS "CDDTOpenGL"
                   IF ISNOTHING(pGL) THEN EXIT FUNCTION
                
                   ' // Initialize OpenGL
                   IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                
                   ' // Display and activate the dialog
                   DIALOG SHOW MODELESS hDlg, CALL DlgProc
                
                   ' // Set the timer
                   SetTimer(hDlg, 1, 0, %NULL)
                
                   ' // Message loop
                   LOCAL uMsg AS tagMsg
                   WHILE GetMessage(uMsg, %NULL, 0, 0)
                      TranslateMessage uMsg
                      DispatchMessage uMsg
                   WEND
                
                   ' // Kill the timer
                   KillTimer(hDlg, 1)
                
                END FUNCTION
                ' ========================================================================================
                
                ' ========================================================================================
                ' Main Dialog procedure
                ' ========================================================================================
                CALLBACK FUNCTION DlgProc() AS LONG
                
                   SELECT CASE CB.MSG
                
                      CASE %WM_SYSCOMMAND
                         ' // Disable the Windows screensaver
                         IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                         ' // Close the window
                         IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                
                      CASE %WM_INITDIALOG
                         ' // Set up the scene
                         pGL.SetupScene
                
                      CASE %WM_TIMER
                         ' // Render the scene
                         pGL.RenderScene
                
                      CASE %WM_SIZE
                         ' // Resize the scene
                         pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                
                      CASE %WM_KEYDOWN
                         ' // Process keystrokes
                         pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                
                      CASE %WM_LBUTTONDOWN
                         ' // Process mouse movements
                         pGL.ProcessMouse CB.HNDL, CB.MSG, CB.WPARAM, LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                
                      CASE %WM_CLOSE
                         ' // Post a message to end the application
                         DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                
                      CASE %WM_DESTROY
                         ' // End the application
                         ' // Use this method instead of DIALOG END with modeless dialogs
                         PostQuitMessage 0
                
                   END SELECT
                
                END FUNCTION
                ' ========================================================================================
                Attached Files
                Forum: http://www.jose.it-berater.org/smfforum/index.php

                Comment


                • #48
                  OpenGL: planet

                  This program shows how to composite modeling transformations to draw translated and rotated models.

                  Interaction: pressing the d and y keys (day and year) alters the rotation of the planet around the sun.

                  Code:
                  ' ########################################################################################
                  ' Microsoft Windows
                  ' File: EX_DDT_OpenGL_planet.bas
                  ' Compilers: PBWIN 10+, PBCC 6+
                  ' Headers: Windows API headers 3.0+
                  ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                  ' ########################################################################################
                  
                  '/*
                  ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                  ' * ALL RIGHTS RESERVED
                  ' * Permission to use, copy, modify, and distribute this software for
                  ' * any purpose and without fee is hereby granted, provided that the above
                  ' * copyright notice appear in all copies and that both the copyright notice
                  ' * and this permission notice appear in supporting documentation, and that
                  ' * the name of Silicon Graphics, Inc. not be used in advertising
                  ' * or publicity pertaining to distribution of the software without specific,
                  ' * written prior permission.
                  ' *
                  ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                  ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                  ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                  ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                  ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                  ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                  ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                  ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                  ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                  ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                  ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                  ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                  ' *
                  ' * US Government Users Restricted Rights
                  ' * Use, duplication, or disclosure by the Government is subject to
                  ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                  ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                  ' * clause at DFARS 252.227-7013 and/or in similar or successor
                  ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                  ' * Unpublished-- rights reserved under the copyright laws of the
                  ' * United States.  Contractor/manufacturer is Silicon Graphics,
                  ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                  ' *
                  ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                  ' */
                  
                  '/*
                  ' *  planet.c
                  ' *  This program shows how to composite modeling transformations
                  ' *  to draw translated and rotated models.
                  ' *  Interaction:  pressing the d and y keys (day and year)
                  ' *  alters the rotation of the planet around the sun.
                  ' */
                  
                  #COMPILE EXE
                  #DIM ALL
                  
                  ' // Include files
                  #INCLUDE ONCE "glu.inc"
                  #INCLUDE ONCE "AfxGlut.inc"
                  
                  $WindowCaption = "DDT OpenGL: planet"
                  
                  GLOBAL pGL AS IDDTOpenGL
                  
                  ' =======================================================================================
                  ' OpenGL class
                  ' =======================================================================================
                  CLASS CDDTOpenGL
                  
                     INSTANCE m_hdc AS DWORD    ' // Device context
                     INSTANCE m_hrc AS DWORD    ' // Rendering context
                     INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                  
                     INSTANCE year, day AS LONG
                  
                     CLASS METHOD Destroy
                        ' // Release the device and rendering contexts
                        IF m_hdc THEN wglMakeCurrent m_hdc, 0
                        ' // Delete the rendering context
                        IF m_hrc THEN wglDeleteContext m_hrc
                        ' // Release the device context
                        IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                     END METHOD
                  
                     ' =====================================================================================
                     INTERFACE IDDTOpenGL : INHERIT IUnknown
                     ' =====================================================================================
                  
                     ' =====================================================================================
                     ' Initializes OpenGL
                     ' =====================================================================================
                     METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                  
                        IF hDlg = 0 THEN EXIT METHOD
                        m_hDlg = hDlg
                  
                        ' // Get the device context
                        m_hdc = GetDC(m_hDlg)
                        IF m_hdc = 0 THEN EXIT METHOD
                  
                        ' // Bits per pixel
                        LOCAL nBitsPerPel AS LONG
                        nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                  
                        ' // Depth bits
                        LOCAL cDepthBits AS LONG
                        cDepthBits = nBitsPerPel - 8
                        IF cDepthBits < 16 THEN cDepthBits = 16
                  
                        ' // Pixel format
                        LOCAL 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
                        LOCAL pf AS LONG
                        pf = ChoosePixelFormat(m_hdc, pfd)
                        IF ISFALSE pf THEN
                           MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                           EXIT METHOD
                        END IF
                  
                        ' // Set the pixel format
                        IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                           MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                           EXIT METHOD
                        END IF
                  
                        ' // Create a new OpenGL rendering context
                        m_hrc = wglCreateContext(m_hdc)
                        IF m_hrc = 0 THEN
                           MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                           SendMessage m_hDlg, %WM_CLOSE, 0, 0
                           EXIT METHOD
                        END IF
                  
                        ' // Make it current
                        IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                           MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                           SendMessage m_hDlg, %WM_CLOSE, 0, 0
                           EXIT METHOD
                        END IF
                  
                        ' // Return success
                        METHOD = %TRUE
                  
                     END METHOD
                     ' =====================================================================================
                  
                     ' =====================================================================================
                     ' All the setup goes here
                     ' =====================================================================================
                     METHOD SetupScene
                  
                        glClearColor 0.0, 0.0, 0.0, 0.0
                        glShadeModel %GL_FLAT
                  
                     END METHOD
                     ' =====================================================================================
                  
                     ' =====================================================================================
                     ' Resize the scene
                     ' =====================================================================================
                     METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                  
                        glViewport 0, 0, w, h
                        glMatrixMode %GL_PROJECTION
                        glLoadIdentity
                        gluPerspective 60.0, w / h, 1.0, 20.0
                        glMatrixMode %GL_MODELVIEW
                        glLoadIdentity
                        gluLookAt 0.0, 0.0, 5.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0
                  
                     END METHOD
                     ' =====================================================================================
                  
                     ' =======================================================================================
                     ' Render the scene
                     '/*  Here is where the light position is reset after the modeling
                     ' *  transformation (glRotated) is called.  This places the
                     ' *  light at a new position in world coordinates.  The cube
                     ' *  represents the position of the light.
                  ' */
                     ' =======================================================================================
                     METHOD RenderScene
                  
                        glClear %GL_COLOR_BUFFER_BIT
                        glColor3f 1.0, 1.0, 1.0
                  
                        glPushMatrix
                        AfxGlutWireSphere 1.0, 20, 16  ' /* draw sun */
                        glRotatef year, 0.0, 1.0, 0.0
                        glTranslatef 2.0, 0.0, 0.0
                        glRotatef day, 0.0, 1.0, 0.0
                        AfxGlutWireSphere 0.2, 10, 8   ' /* draw smaller planet */
                        glPopMatrix
                  
                        ' // Exchange the front and back buffers
                        SwapBuffers m_hdc
                  
                     END METHOD
                     ' =======================================================================================
                  
                     ' ====================================================================================
                     ' Processes keystrokes
                     ' ====================================================================================
                     METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                        SELECT CASE wMsg
                           CASE %WM_KEYDOWN
                              SELECT CASE LO(WORD, wParam)
                                 CASE %VK_ESCAPE
                                    ' // Send a message to close the application
                                    DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                 CASE %VK_D
                                    day = (day + 10) MOD 360
                                 CASE %VK_Y
                                    year = (year + 5) MOD 360
                              END SELECT
                        END SELECT
                     END METHOD
                     ' ====================================================================================
                  
                     END INTERFACE
                  
                  END CLASS
                  ' =======================================================================================
                  
                  ' ========================================================================================
                  ' Main
                  ' ========================================================================================
                  FUNCTION PBMAIN () AS LONG
                  
                     ' // Create the dialog
                     LOCAL hDlg AS DWORD
                     DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                  
                     ' // Create an instance of the DX9 class
                     pGL = CLASS "CDDTOpenGL"
                     IF ISNOTHING(pGL) THEN EXIT FUNCTION
                  
                     ' // Initialize OpenGL
                     IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                  
                     ' // Display and activate the dialog
                     DIALOG SHOW MODELESS hDlg, CALL DlgProc
                  
                     ' // Set the timer
                     SetTimer(hDlg, 1, 0, %NULL)
                  
                     ' // Message loop
                     LOCAL uMsg AS tagMsg
                     WHILE GetMessage(uMsg, %NULL, 0, 0)
                        TranslateMessage uMsg
                        DispatchMessage uMsg
                     WEND
                  
                     ' // Kill the timer
                     KillTimer(hDlg, 1)
                  
                  END FUNCTION
                  ' ========================================================================================
                  
                  ' ========================================================================================
                  ' Main Dialog procedure
                  ' ========================================================================================
                  CALLBACK FUNCTION DlgProc() AS LONG
                  
                     SELECT CASE CB.MSG
                  
                        CASE %WM_SYSCOMMAND
                           ' // Disable the Windows screensaver
                           IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                           ' // Close the window
                           IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                  
                        CASE %WM_INITDIALOG
                           ' // Set up the scene
                           pGL.SetupScene
                  
                        CASE %WM_TIMER
                           ' // Render the scene
                           pGL.RenderScene
                  
                        CASE %WM_SIZE
                           ' // Resize the scene
                           pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                  
                        CASE %WM_KEYDOWN
                           ' // Process keystrokes
                           pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                  
                        CASE %WM_CLOSE
                           ' // Post a message to end the application
                           DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                  
                        CASE %WM_DESTROY
                           ' // End the application
                           ' // Use this method instead of DIALOG END with modeless dialogs
                           PostQuitMessage 0
                  
                     END SELECT
                  
                  END FUNCTION
                  ' ========================================================================================
                  Attached Files
                  Forum: http://www.jose.it-berater.org/smfforum/index.php

                  Comment


                  • #49
                    OpenGL: polyoff

                    This program demonstrates polygon offset to draw a shaded polygon and its wireframe counterpart without ugly visual artifacts ("stitching").

                    Code:
                    ' ########################################################################################
                    ' Microsoft Windows
                    ' File: EX_DDT_OpenGL_polyoff.bas
                    ' Compilers: PBWIN 10+, PBCC 6+
                    ' Headers: Windows API headers 3.0+
                    ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                    ' ########################################################################################
                    
                    '/*
                    ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                    ' * ALL RIGHTS RESERVED
                    ' * Permission to use, copy, modify, and distribute this software for
                    ' * any purpose and without fee is hereby granted, provided that the above
                    ' * copyright notice appear in all copies and that both the copyright notice
                    ' * and this permission notice appear in supporting documentation, and that
                    ' * the name of Silicon Graphics, Inc. not be used in advertising
                    ' * or publicity pertaining to distribution of the software without specific,
                    ' * written prior permission.
                    ' *
                    ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                    ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                    ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                    ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                    ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                    ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                    ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                    ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                    ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                    ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                    ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                    ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                    ' *
                    ' * US Government Users Restricted Rights
                    ' * Use, duplication, or disclosure by the Government is subject to
                    ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                    ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                    ' * clause at DFARS 252.227-7013 and/or in similar or successor
                    ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                    ' * Unpublished-- rights reserved under the copyright laws of the
                    ' * United States.  Contractor/manufacturer is Silicon Graphics,
                    ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                    ' *
                    ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                    ' */
                    
                    '/*
                    ' *  polyoff.c
                    ' *  This program demonstrates polygon offset to draw a shaded
                    ' *  polygon and its wireframe counterpart without ugly visual
                    ' *  artifacts ("stitching").
                    ' */
                    
                    #COMPILE EXE
                    #DIM ALL
                    
                    ' // Include files
                    #INCLUDE ONCE "glu.inc"
                    #INCLUDE ONCE "AfxGlut.inc"
                    
                    $WindowCaption = "DDT OpenGL: polyoff"
                    
                    GLOBAL pGL AS IDDTOpenGL
                    
                    ' =======================================================================================
                    ' OpenGL class
                    ' =======================================================================================
                    CLASS CDDTOpenGL
                    
                       INSTANCE m_hdc AS DWORD    ' // Device context
                       INSTANCE m_hrc AS DWORD    ' // Rendering context
                       INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                    
                       INSTANCE list AS DWORD
                       INSTANCE spinx AS LONG
                       INSTANCE spiny AS LONG
                       INSTANCE tdist AS SINGLE
                       INSTANCE polyfactor AS SINGLE
                       INSTANCE polyunits AS SINGLE
                    
                       CLASS METHOD Destroy
                          ' // Release the device and rendering contexts
                          IF m_hdc THEN wglMakeCurrent m_hdc, 0
                          ' // Delete the rendering context
                          IF m_hrc THEN wglDeleteContext m_hrc
                          ' // Release the device context
                          IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                       END METHOD
                    
                       ' =====================================================================================
                       INTERFACE IDDTOpenGL : INHERIT IUnknown
                       ' =====================================================================================
                    
                       ' =====================================================================================
                       ' Initializes OpenGL
                       ' =====================================================================================
                       METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                    
                          IF hDlg = 0 THEN EXIT METHOD
                          m_hDlg = hDlg
                    
                          ' // Get the device context
                          m_hdc = GetDC(m_hDlg)
                          IF m_hdc = 0 THEN EXIT METHOD
                    
                          ' // Bits per pixel
                          LOCAL nBitsPerPel AS LONG
                          nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                    
                          ' // Depth bits
                          LOCAL cDepthBits AS LONG
                          cDepthBits = nBitsPerPel - 8
                          IF cDepthBits < 16 THEN cDepthBits = 16
                    
                          ' // Pixel format
                          LOCAL 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
                          LOCAL pf AS LONG
                          pf = ChoosePixelFormat(m_hdc, pfd)
                          IF ISFALSE pf THEN
                             MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                             EXIT METHOD
                          END IF
                    
                          ' // Set the pixel format
                          IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                             MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                             EXIT METHOD
                          END IF
                    
                          ' // Create a new OpenGL rendering context
                          m_hrc = wglCreateContext(m_hdc)
                          IF m_hrc = 0 THEN
                             MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                             SendMessage m_hDlg, %WM_CLOSE, 0, 0
                             EXIT METHOD
                          END IF
                    
                          ' // Make it current
                          IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                             MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                             SendMessage m_hDlg, %WM_CLOSE, 0, 0
                             EXIT METHOD
                          END IF
                    
                          ' // Return success
                          METHOD = %TRUE
                    
                       END METHOD
                       ' =====================================================================================
                    
                       ' =====================================================================================
                       ' All the setup goes here
                       ' =====================================================================================
                       METHOD SetupScene
                    
                          polyfactor = 1.0
                          polyunits = 1.0
                    
                          DIM light_ambient(3) AS SINGLE
                          DIM light_diffuse(3) AS SINGLE
                          DIM light_specular(3) AS SINGLE
                          DIM light_position(3) AS SINGLE
                          DIM global_ambient(3) AS SINGLE
                    
                          ARRAY ASSIGN light_ambient() = 0.0, 0.0, 0.0, 1.0
                          ARRAY ASSIGN light_diffuse() = 1.0, 1.0, 1.0, 1.0
                          ARRAY ASSIGN light_specular() = 1.0, 1.0, 1.0, 1.0
                          ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
                    
                          ARRAY ASSIGN global_ambient() = 0.2, 0.2, 0.2, 1.0
                    
                          glClearColor 0.0, 0.0, 0.0, 1.0
                    
                          list = glGenLists(1)
                          glNewList list, %GL_COMPILE
                             AfxGlutSolidSphere 1.0, 20, 12
                          glEndList
                    
                          glEnable %GL_DEPTH_TEST
                    
                          glLightfv %GL_LIGHT0, %GL_AMBIENT, light_ambient(0)
                          glLightfv %GL_LIGHT0, %GL_DIFFUSE, light_diffuse(0)
                          glLightfv %GL_LIGHT0, %GL_SPECULAR, light_specular(0)
                          glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
                          glLightModelfv %GL_LIGHT_MODEL_AMBIENT, global_ambient(0)
                    
                       END METHOD
                       ' =====================================================================================
                    
                       ' =====================================================================================
                       ' Resize the scene
                       ' =====================================================================================
                       METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                    
                          glViewport 0, 0, w, h
                          glMatrixMode %GL_PROJECTION
                          glLoadIdentity
                          gluPerspective 45.0, w / h, 1.0, 10.0
                          glMatrixMode %GL_MODELVIEW
                          glLoadIdentity
                          gluLookAt 0.0, 0.0, 5.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0
                    
                       END METHOD
                       ' =====================================================================================
                    
                       ' =======================================================================================
                       ' Render the scene
                       '/*  Here is where the light position is reset after the modeling
                       ' *  transformation (glRotated) is called.  This places the
                       ' *  light at a new position in world coordinates.  The cube
                       ' *  represents the position of the light.
                    ' */
                       ' =======================================================================================
                       METHOD RenderScene
                    
                          DIM rggray(3) AS SINGLE
                          DIM rgblack(3) AS SINGLE
                    
                          ARRAY ASSIGN rggray() = 0.8, 0.8, 0.8, 1.0
                          ARRAY ASSIGN rgblack() = 0.0, 0.0, 0.0, 1.0
                    
                          glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                          glPushMatrix
                          glTranslatef 0.0, 0.0, tdist
                          glRotatef spinx, 1.0, 0.0, 0.0
                          glRotatef spiny, 0.0, 1.0, 0.0
                    
                          glMaterialfv %GL_FRONT, %GL_AMBIENT_AND_DIFFUSE, rggray(0)
                          glMaterialfv %GL_FRONT, %GL_SPECULAR, rgblack(0)
                          glMaterialf %GL_FRONT, %GL_SHININESS, 0.0
                          glEnable %GL_LIGHTING
                          glEnable %GL_LIGHT0
                          glEnable %GL_POLYGON_OFFSET_FILL
                          glPolygonOffset polyfactor, polyunits
                          glCallList list
                          glDisable %GL_POLYGON_OFFSET_FILL
                    
                          glDisable %GL_LIGHTING
                          glDisable %GL_LIGHT0
                          glColor3f 1.0, 1.0, 1.0
                          glPolygonMode %GL_FRONT_AND_BACK, %GL_LINE
                          glCallList list
                          glPolygonMode %GL_FRONT_AND_BACK, %GL_FILL
                    
                          glPopMatrix
                          glFlush
                    
                          ' // Exchange the front and back buffers
                          SwapBuffers m_hdc
                    
                       END METHOD
                       ' =======================================================================================
                    
                       ' ====================================================================================
                       ' Processes keystrokes
                       ' ====================================================================================
                       METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                          SELECT CASE wMsg
                             CASE %WM_KEYDOWN
                                SELECT CASE LO(WORD, wParam)
                                   CASE %VK_ESCAPE
                                      ' // Send a message to close the application
                                      DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                   CASE %VK_T
                                      IF GetAsyncKeyState(%VK_SHIFT) THEN
                                         IF tdist > -5.0 THEN
                                            tdist = tdist - 0.5
                                         END IF
                                      ELSE
                                         IF tdist < 4.0 THEN
                                            tdist = tdist + 0.5
                                         END IF
                                      END IF
                                   CASE %VK_F
                                      IF GetAsyncKeyState(%VK_SHIFT) THEN
                                         polyfactor = polyfactor - 0.1
                                      ELSE
                                         polyfactor = polyfactor + 0.1
                                      END IF
                                   CASE %VK_U
                                      IF GetAsyncKeyState(%VK_SHIFT) THEN
                                         polyunits = polyunits - 1.0
                                      ELSE
                                         polyunits = polyunits + 1.0
                                      END IF
                                END SELECT
                          END SELECT
                       END METHOD
                       ' ====================================================================================
                    
                       ' ====================================================================================
                       ' Processes mouse clicks and movement
                       ' Parameters:
                       ' * hDlg      = Dialog hande
                       ' * 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
                       ' ====================================================================================
                       METHOD ProcessMouse (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)
                    
                          SELECT CASE wMsg
                             CASE %WM_LBUTTONDOWN
                                spinx = (spinx + 5) MOD 360
                             CASE %WM_RBUTTONDOWN
                                spiny = (spiny + 5) MOD 360
                          END SELECT
                    
                       END METHOD
                       ' ====================================================================================
                    
                       END INTERFACE
                    
                    END CLASS
                    ' =======================================================================================
                    
                    ' ========================================================================================
                    ' Main
                    ' ========================================================================================
                    FUNCTION PBMAIN () AS LONG
                    
                       ' // Create the dialog
                       LOCAL hDlg AS DWORD
                       DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                    
                       ' // Create an instance of the DX9 class
                       pGL = CLASS "CDDTOpenGL"
                       IF ISNOTHING(pGL) THEN EXIT FUNCTION
                    
                       ' // Initialize OpenGL
                       IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                    
                       ' // Display and activate the dialog
                       DIALOG SHOW MODELESS hDlg, CALL DlgProc
                    
                       ' // Set the timer
                       SetTimer(hDlg, 1, 0, %NULL)
                    
                       ' // Message loop
                       LOCAL uMsg AS tagMsg
                       WHILE GetMessage(uMsg, %NULL, 0, 0)
                          TranslateMessage uMsg
                          DispatchMessage uMsg
                       WEND
                    
                       ' // Kill the timer
                       KillTimer(hDlg, 1)
                    
                    END FUNCTION
                    ' ========================================================================================
                    
                    ' ========================================================================================
                    ' Main Dialog procedure
                    ' ========================================================================================
                    CALLBACK FUNCTION DlgProc() AS LONG
                    
                       SELECT CASE CB.MSG
                    
                          CASE %WM_SYSCOMMAND
                             ' // Disable the Windows screensaver
                             IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                             ' // Close the window
                             IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                    
                          CASE %WM_INITDIALOG
                             ' // Set up the scene
                             pGL.SetupScene
                    
                          CASE %WM_TIMER
                             ' // Render the scene
                             pGL.RenderScene
                    
                          CASE %WM_SIZE
                             ' // Resize the scene
                             pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                    
                          CASE %WM_KEYDOWN
                             ' // Process keystrokes
                             pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                    
                          CASE %WM_LBUTTONDOWN, %WM_RBUTTONDOWN
                             ' // Process mouse movements
                             pGL.ProcessMouse CB.HNDL, CB.MSG, CB.WPARAM, LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                    
                          CASE %WM_CLOSE
                             ' // Post a message to end the application
                             DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                    
                          CASE %WM_DESTROY
                             ' // End the application
                             ' // Use this method instead of DIALOG END with modeless dialogs
                             PostQuitMessage 0
                    
                       END SELECT
                    
                    END FUNCTION
                    ' ========================================================================================
                    Attached Files
                    Forum: http://www.jose.it-berater.org/smfforum/index.php

                    Comment


                    • #50
                      OpenGL: polys

                      This program demonstrates polygon stippling.

                      Code:
                      ' ########################################################################################
                      ' Microsoft Windows
                      ' File: EX_DDT_OpenGL_polys.bas
                      ' Compilers: PBWIN 10+, PBCC 6+
                      ' Headers: Windows API headers 3.0+
                      ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                      ' ########################################################################################
                      
                      '/*
                      ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                      ' * ALL RIGHTS RESERVED
                      ' * Permission to use, copy, modify, and distribute this software for
                      ' * any purpose and without fee is hereby granted, provided that the above
                      ' * copyright notice appear in all copies and that both the copyright notice
                      ' * and this permission notice appear in supporting documentation, and that
                      ' * the name of Silicon Graphics, Inc. not be used in advertising
                      ' * or publicity pertaining to distribution of the software without specific,
                      ' * written prior permission.
                      ' *
                      ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                      ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                      ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                      ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                      ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                      ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                      ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                      ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                      ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                      ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                      ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                      ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                      ' *
                      ' * US Government Users Restricted Rights
                      ' * Use, duplication, or disclosure by the Government is subject to
                      ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                      ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                      ' * clause at DFARS 252.227-7013 and/or in similar or successor
                      ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                      ' * Unpublished-- rights reserved under the copyright laws of the
                      ' * United States.  Contractor/manufacturer is Silicon Graphics,
                      ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                      ' *
                      ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                      ' */
                      
                      '/*
                      ' *  polys.c
                      ' *  This program demonstrates polygon stippling.
                      ' */
                      
                      #COMPILE EXE
                      #DIM ALL
                      
                      ' // Include files
                      #INCLUDE ONCE "glu.inc"
                      
                      $WindowCaption = "DDT OpenGL: polys"
                      
                      GLOBAL pGL AS IDDTOpenGL
                      
                      ' =======================================================================================
                      ' OpenGL class
                      ' =======================================================================================
                      CLASS CDDTOpenGL
                      
                         INSTANCE m_hdc AS DWORD    ' // Device context
                         INSTANCE m_hrc AS DWORD    ' // Rendering context
                         INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                      
                         CLASS METHOD Destroy
                            ' // Release the device and rendering contexts
                            IF m_hdc THEN wglMakeCurrent m_hdc, 0
                            ' // Delete the rendering context
                            IF m_hrc THEN wglDeleteContext m_hrc
                            ' // Release the device context
                            IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                         END METHOD
                      
                         ' =====================================================================================
                         INTERFACE IDDTOpenGL : INHERIT IUnknown
                         ' =====================================================================================
                      
                         ' =====================================================================================
                         ' Initializes OpenGL
                         ' =====================================================================================
                         METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                      
                            IF hDlg = 0 THEN EXIT METHOD
                            m_hDlg = hDlg
                      
                            ' // Get the device context
                            m_hdc = GetDC(m_hDlg)
                            IF m_hdc = 0 THEN EXIT METHOD
                      
                            ' // Bits per pixel
                            LOCAL nBitsPerPel AS LONG
                            nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                      
                            ' // Depth bits
                            LOCAL cDepthBits AS LONG
                            cDepthBits = nBitsPerPel - 8
                            IF cDepthBits < 16 THEN cDepthBits = 16
                      
                            ' // Pixel format
                            LOCAL 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
                            LOCAL pf AS LONG
                            pf = ChoosePixelFormat(m_hdc, pfd)
                            IF ISFALSE pf THEN
                               MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                               EXIT METHOD
                            END IF
                      
                            ' // Set the pixel format
                            IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                               MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                               EXIT METHOD
                            END IF
                      
                            ' // Create a new OpenGL rendering context
                            m_hrc = wglCreateContext(m_hdc)
                            IF m_hrc = 0 THEN
                               MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                               SendMessage m_hDlg, %WM_CLOSE, 0, 0
                               EXIT METHOD
                            END IF
                      
                            ' // Make it current
                            IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                               MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                               SendMessage m_hDlg, %WM_CLOSE, 0, 0
                               EXIT METHOD
                            END IF
                      
                            ' // Return success
                            METHOD = %TRUE
                      
                         END METHOD
                         ' =====================================================================================
                      
                         ' =====================================================================================
                         ' All the setup goes here
                         ' =====================================================================================
                         METHOD SetupScene
                      
                            glClearColor 0.0, 0.0, 0.0, 0.0
                            glShadeModel %GL_FLAT
                      
                         END METHOD
                         ' =====================================================================================
                      
                         ' =====================================================================================
                         ' Resize the scene
                         ' =====================================================================================
                         METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                      
                            glViewport 0, 0, w, h
                            glMatrixMode %GL_PROJECTION
                            glLoadIdentity
                            gluOrtho2D 0.0, w, 0.0, h
                      
                         END METHOD
                         ' =====================================================================================
                      
                         ' =======================================================================================
                         ' Render the scene
                         ' =======================================================================================
                         METHOD RenderScene
                      
                            DIM fly(128) AS BYTE
                      
                            ARRAY ASSIGN fly() = _
                               &H00, &H00, &H00, &H00, &H00, &H00, &H00, &H00, _
                               &H03, &H80, &H01, &HC0, &H06, &HC0, &H03, &H60, _
                               &H04, &H60, &H06, &H20, &H04, &H30, &H0C, &H20, _
                               &H04, &H18, &H18, &H20, &H04, &H0C, &H30, &H20, _
                               &H04, &H06, &H60, &H20, &H44, &H03, &HC0, &H22, _
                               &H44, &H01, &H80, &H22, &H44, &H01, &H80, &H22, _
                               &H44, &H01, &H80, &H22, &H44, &H01, &H80, &H22, _
                               &H44, &H01, &H80, &H22, &H44, &H01, &H80, &H22, _
                               &H66, &H01, &H80, &H66, &H33, &H01, &H80, &HCC, _
                               &H19, &H81, &H81, &H98, &H0C, &HC1, &H83, &H30, _
                               &H07, &He1, &H87, &He0, &H03, &H3f, &Hfc, &Hc0, _
                               &H03, &H31, &H8c, &Hc0, &H03, &H33, &Hcc, &Hc0, _
                               &H06, &H64, &H26, &H60, &H0c, &Hcc, &H33, &H30, _
                               &H18, &Hcc, &H33, &H18, &H10, &Hc4, &H23, &H08, _
                               &H10, &H63, &HC6, &H08, &H10, &H30, &H0c, &H08, _
                               &H10, &H18, &H18, &H08, &H10, &H00, &H00, &H08
                      
                            DIM halftone(128) AS BYTE
                      
                            ARRAY ASSIGN halftone() = _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55, _
                               &HAA, &HAA, &HAA, &HAA, &H55, &H55, &H55, &H55
                      
                            glClear %GL_COLOR_BUFFER_BIT
                            glColor3f 1.0, 1.0, 1.0
                      
                            '/*  draw one solid, unstippled rectangle,	*/
                            '/*  then two stippled rectangles		*/
                            glRectf 25.0, 25.0, 125.0, 125.0
                            glEnable %GL_POLYGON_STIPPLE
                            glPolygonStipple fly(0)
                            glRectf 125.0, 25.0, 225.0, 125.0
                            glPolygonStipple halftone(0)
                            glRectf 225.0, 25.0, 325.0, 125.0
                            glDisable %GL_POLYGON_STIPPLE
                      
                            glFlush
                      
                            ' // Exchange the front and back buffers
                            SwapBuffers m_hdc
                      
                         END METHOD
                         ' =======================================================================================
                      
                         ' ====================================================================================
                         ' Processes keystrokes
                         ' ====================================================================================
                         METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                            SELECT CASE wMsg
                               CASE %WM_KEYDOWN
                                  SELECT CASE LO(WORD, wParam)
                                     CASE %VK_ESCAPE
                                        ' // Send a message to close the application
                                        DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                  END SELECT
                            END SELECT
                         END METHOD
                         ' ====================================================================================
                      
                         END INTERFACE
                      
                      END CLASS
                      ' =======================================================================================
                      
                      ' ========================================================================================
                      ' Main
                      ' ========================================================================================
                      FUNCTION PBMAIN () AS LONG
                      
                         ' // Create the dialog
                         LOCAL hDlg AS DWORD
                         DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                      
                         ' // Create an instance of the DX9 class
                         pGL = CLASS "CDDTOpenGL"
                         IF ISNOTHING(pGL) THEN EXIT FUNCTION
                      
                         ' // Initialize OpenGL
                         IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                      
                         ' // Display and activate the dialog
                         DIALOG SHOW MODELESS hDlg, CALL DlgProc
                      
                         ' // Set the timer
                         SetTimer(hDlg, 1, 0, %NULL)
                      
                         ' // Message loop
                         LOCAL uMsg AS tagMsg
                         WHILE GetMessage(uMsg, %NULL, 0, 0)
                            TranslateMessage uMsg
                            DispatchMessage uMsg
                         WEND
                      
                         ' // Kill the timer
                         KillTimer(hDlg, 1)
                      
                      END FUNCTION
                      ' ========================================================================================
                      
                      ' ========================================================================================
                      ' Main Dialog procedure
                      ' ========================================================================================
                      CALLBACK FUNCTION DlgProc() AS LONG
                      
                         SELECT CASE CB.MSG
                      
                            CASE %WM_SYSCOMMAND
                               ' // Disable the Windows screensaver
                               IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                               ' // Close the window
                               IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                      
                            CASE %WM_INITDIALOG
                               ' // Set up the scene
                               pGL.SetupScene
                      
                            CASE %WM_TIMER
                               ' // Render the scene
                               pGL.RenderScene
                      
                            CASE %WM_SIZE
                               ' // Resize the scene
                               pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                      
                            CASE %WM_KEYDOWN
                               ' // Process keystrokes
                               pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                      
                            CASE %WM_CLOSE
                               ' // Post a message to end the application
                               DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                      
                            CASE %WM_DESTROY
                               ' // End the application
                               ' // Use this method instead of DIALOG END with modeless dialogs
                               PostQuitMessage 0
                      
                         END SELECT
                      
                      END FUNCTION
                      ' ========================================================================================
                      Attached Files
                      Forum: http://www.jose.it-berater.org/smfforum/index.php

                      Comment


                      • #51
                        OpenGL: quadric

                        This program demonstrates the use of some of the gluQuadric routines. Quadric objects are created with some quadric properties and the callback routine to handle errors. Note that the cylinder has no top or bottom and the circle has a hole in it.

                        Code:
                        ' ########################################################################################
                        ' Microsoft Windows
                        ' File: EX_DDT_OpenGL_quadric.bas
                        ' Compilers: PBWIN 10+, PBCC 6+
                        ' Headers: Windows API headers 3.0+
                        ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                        ' ########################################################################################
                        
                        '/*
                        ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                        ' * ALL RIGHTS RESERVED
                        ' * Permission to use, copy, modify, and distribute this software for
                        ' * any purpose and without fee is hereby granted, provided that the above
                        ' * copyright notice appear in all copies and that both the copyright notice
                        ' * and this permission notice appear in supporting documentation, and that
                        ' * the name of Silicon Graphics, Inc. not be used in advertising
                        ' * or publicity pertaining to distribution of the software without specific,
                        ' * written prior permission.
                        ' *
                        ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                        ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                        ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                        ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                        ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                        ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                        ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                        ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                        ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                        ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                        ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                        ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                        ' *
                        ' * US Government Users Restricted Rights
                        ' * Use, duplication, or disclosure by the Government is subject to
                        ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                        ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                        ' * clause at DFARS 252.227-7013 and/or in similar or successor
                        ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                        ' * Unpublished-- rights reserved under the copyright laws of the
                        ' * United States.  Contractor/manufacturer is Silicon Graphics,
                        ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                        ' *
                        ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                        ' */
                        
                        '/*
                        ' *  quadric.c
                        ' *  This program demonstrates the use of some of the gluQuadric*
                        ' *  routines. Quadric objects are created with some quadric
                        ' *  properties and the callback routine to handle errors.
                        ' *  Note that the cylinder has no top or bottom and the circle
                        ' *  has a hole in it.
                        ' */
                        
                        #COMPILE EXE
                        #DIM ALL
                        
                        ' // Include files
                        #INCLUDE ONCE "glu.inc"
                        
                        $WindowCaption = "DDT OpenGL: quadric"
                        
                        GLOBAL pGL AS IDDTOpenGL
                        
                        ' =======================================================================================
                        ' OpenGL class
                        ' =======================================================================================
                        CLASS CDDTOpenGL
                        
                           INSTANCE m_hdc AS DWORD    ' // Device context
                           INSTANCE m_hrc AS DWORD    ' // Rendering context
                           INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                        
                           INSTANCE startList AS DWORD
                        
                           CLASS METHOD Destroy
                              ' // Release the device and rendering contexts
                              IF m_hdc THEN wglMakeCurrent m_hdc, 0
                              ' // Delete the rendering context
                              IF m_hrc THEN wglDeleteContext m_hrc
                              ' // Release the device context
                              IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                           END METHOD
                        
                           ' =====================================================================================
                           INTERFACE IDDTOpenGL : INHERIT IUnknown
                           ' =====================================================================================
                        
                           ' =====================================================================================
                           ' Initializes OpenGL
                           ' =====================================================================================
                           METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                        
                              IF hDlg = 0 THEN EXIT METHOD
                              m_hDlg = hDlg
                        
                              ' // Get the device context
                              m_hdc = GetDC(m_hDlg)
                              IF m_hdc = 0 THEN EXIT METHOD
                        
                              ' // Bits per pixel
                              LOCAL nBitsPerPel AS LONG
                              nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                        
                              ' // Depth bits
                              LOCAL cDepthBits AS LONG
                              cDepthBits = nBitsPerPel - 8
                              IF cDepthBits < 16 THEN cDepthBits = 16
                        
                              ' // Pixel format
                              LOCAL 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
                              LOCAL pf AS LONG
                              pf = ChoosePixelFormat(m_hdc, pfd)
                              IF ISFALSE pf THEN
                                 MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                 EXIT METHOD
                              END IF
                        
                              ' // Set the pixel format
                              IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                 MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                 EXIT METHOD
                              END IF
                        
                              ' // Create a new OpenGL rendering context
                              m_hrc = wglCreateContext(m_hdc)
                              IF m_hrc = 0 THEN
                                 MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                 EXIT METHOD
                              END IF
                        
                              ' // Make it current
                              IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                 MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                 EXIT METHOD
                              END IF
                        
                              ' // Return success
                              METHOD = %TRUE
                        
                           END METHOD
                           ' =====================================================================================
                        
                           ' =====================================================================================
                           ' All the setup goes here
                           ' =====================================================================================
                           METHOD SetupScene
                        
                              LOCAL qobj AS DWORD
                              DIM mat_ambient(3) AS SINGLE
                              DIM mat_specular(3) AS SINGLE
                              DIM mat_shininess(0) AS SINGLE
                              DIM light_position(3) AS SINGLE
                              DIM model_ambient(3) AS SINGLE
                        
                              ARRAY ASSIGN mat_ambient() = 0.5, 0.5, 0.5, 1.0
                              ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
                              ARRAY ASSIGN mat_shininess() = 50.0
                              ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
                              ARRAY ASSIGN model_ambient() = 0.5, 0.5, 0.5, 1.0
                        
                              glClearColor 0.0, 0.0, 0.0, 0.0
                        
                              glMaterialfv %GL_FRONT, %GL_AMBIENT, mat_ambient(0)
                              glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                              glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
                              glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
                              glLightModelfv %GL_LIGHT_MODEL_AMBIENT, model_ambient(0)
                        
                              glEnable %GL_LIGHTING
                              glEnable %GL_LIGHT0
                              glEnable %GL_DEPTH_TEST
                        
                              '/*  Create 4 display lists, each with a different quadric object.
                              ' *  Different drawing styles and surface normal specifications
                              ' *  are demonstrated.
                              ' */
                              startList = glGenLists(4)
                              qobj = gluNewQuadric()
                           '   gluQuadricCallback(qobj, GLU_ERROR,
                           '                      errorCallback);
                        
                              gluQuadricDrawStyle qobj, %GLU_FILL  ' /* smooth shaded */
                              gluQuadricNormals qobj, %GLU_SMOOTH
                              glNewList startList, %GL_COMPILE
                                 gluSphere qobj, 0.75, 15, 10
                              glEndList
                        
                              gluQuadricDrawStyle qobj, %GLU_FILL ' /* flat shaded */
                              gluQuadricNormals qobj, %GLU_FLAT
                              glNewList startList + 1, %GL_COMPILE
                                 gluCylinder qobj, 0.5, 0.3, 1.0, 15, 5
                              glEndList
                        
                              gluQuadricDrawStyle qobj, %GLU_LINE  ' /* all polygons wireframe */
                              gluQuadricNormals qobj, %GLU_NONE
                              glNewList startList + 2, %GL_COMPILE
                                 gluDisk qobj, 0.25, 1.0, 20, 4
                              glEndList
                        
                              gluQuadricDrawStyle qobj, %GLU_SILHOUETTE  ' /* boundary only  */
                              gluQuadricNormals qobj, %GLU_NONE
                              glNewList startList + 3, %GL_COMPILE
                                 gluPartialDisk qobj, 0.0, 1.0, 20, 4, 0.0, 225.0
                              glEndList
                        
                           END METHOD
                           ' =====================================================================================
                        
                           ' =====================================================================================
                           ' Resize the scene
                           ' =====================================================================================
                           METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                        
                              glViewport 0, 0, w, h
                              glMatrixMode %GL_PROJECTION
                              glLoadIdentity
                              IF w <= h THEN
                                 glOrtho -2.5, 2.5, -2.5 * h / w, _
                                    2.5 * h / w, -10.0, 10.0
                              ELSE
                                 glOrtho -2.5 * w / h, _
                                    2.5 * w / h, -2.5, 2.5, -10.0, 10.0
                              END IF
                              glMatrixMode %GL_MODELVIEW
                              glLoadIdentity
                        
                           END METHOD
                           ' =====================================================================================
                        
                           ' =======================================================================================
                           ' Render the scene
                           ' =======================================================================================
                           METHOD RenderScene
                        
                              glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                              glPushMatrix
                        
                              glEnable %GL_LIGHTING
                              glShadeModel %GL_SMOOTH
                              glTranslatef -1.0, -1.0, 0.0
                              glCallList startList
                        
                              glShadeModel %GL_FLAT
                              glTranslatef 0.0, 2.0, 0.0
                              glPushMatrix
                              glRotatef 300.0, 1.0, 0.0, 0.0
                              glCallList startList + 1
                              glPopMatrix
                        
                              glDisable %GL_LIGHTING
                              glColor3f 0.0, 1.0, 1.0
                              glTranslatef 2.0, -2.0, 0.0
                              glCallList startList + 2
                        
                              glColor3f 1.0, 1.0, 0.0
                              glTranslatef 0.0, 2.0, 0.0
                              glCallList startList + 3
                        
                              glPopMatrix
                              glFlush
                        
                              ' // Exchange the front and back buffers
                              SwapBuffers m_hdc
                        
                           END METHOD
                           ' =======================================================================================
                        
                           ' ====================================================================================
                           ' Processes keystrokes
                           ' ====================================================================================
                           METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                              SELECT CASE wMsg
                                 CASE %WM_KEYDOWN
                                    SELECT CASE LO(WORD, wParam)
                                       CASE %VK_ESCAPE
                                          ' // Send a message to close the application
                                          DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                    END SELECT
                              END SELECT
                           END METHOD
                           ' ====================================================================================
                        
                           END INTERFACE
                        
                        END CLASS
                        ' =======================================================================================
                        
                        ' ========================================================================================
                        ' Main
                        ' ========================================================================================
                        FUNCTION PBMAIN () AS LONG
                        
                           ' // Create the dialog
                           LOCAL hDlg AS DWORD
                           DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                        
                           ' // Create an instance of the DX9 class
                           pGL = CLASS "CDDTOpenGL"
                           IF ISNOTHING(pGL) THEN EXIT FUNCTION
                        
                           ' // Initialize OpenGL
                           IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                        
                           ' // Display and activate the dialog
                           DIALOG SHOW MODELESS hDlg, CALL DlgProc
                        
                           ' // Set the timer
                           SetTimer(hDlg, 1, 0, %NULL)
                        
                           ' // Message loop
                           LOCAL uMsg AS tagMsg
                           WHILE GetMessage(uMsg, %NULL, 0, 0)
                              TranslateMessage uMsg
                              DispatchMessage uMsg
                           WEND
                        
                           ' // Kill the timer
                           KillTimer(hDlg, 1)
                        
                        END FUNCTION
                        ' ========================================================================================
                        
                        ' ========================================================================================
                        ' Main Dialog procedure
                        ' ========================================================================================
                        CALLBACK FUNCTION DlgProc() AS LONG
                        
                           SELECT CASE CB.MSG
                        
                              CASE %WM_SYSCOMMAND
                                 ' // Disable the Windows screensaver
                                 IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                 ' // Close the window
                                 IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                        
                              CASE %WM_INITDIALOG
                                 ' // Set up the scene
                                 pGL.SetupScene
                        
                              CASE %WM_TIMER
                                 ' // Render the scene
                                 pGL.RenderScene
                        
                              CASE %WM_SIZE
                                 ' // Resize the scene
                                 pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                        
                              CASE %WM_KEYDOWN
                                 ' // Process keystrokes
                                 pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                        
                              CASE %WM_CLOSE
                                 ' // Post a message to end the application
                                 DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                        
                              CASE %WM_DESTROY
                                 ' // End the application
                                 ' // Use this method instead of DIALOG END with modeless dialogs
                                 PostQuitMessage 0
                        
                           END SELECT
                        
                        END FUNCTION
                        ' ========================================================================================
                        Attached Files
                        Forum: http://www.jose.it-berater.org/smfforum/index.php

                        Comment


                        • #52
                          OpenGL: robot

                          This program draws shows how to draw anti-aliased lines in color index mode. It draws two diagonal lines to form an X; when 'r' is typed in the window, the lines are rotated in opposite directions.

                          Code:
                          ' ########################################################################################
                          ' Microsoft Windows
                          ' File: EX_DDT_OpenGL_robot.bas
                          ' Compilers: PBWIN 10+, PBCC 6+
                          ' Headers: Windows API headers 3.0+
                          ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                          ' ########################################################################################
                          
                          '/*
                          ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                          ' * ALL RIGHTS RESERVED
                          ' * Permission to use, copy, modify, and distribute this software for
                          ' * any purpose and without fee is hereby granted, provided that the above
                          ' * copyright notice appear in all copies and that both the copyright notice
                          ' * and this permission notice appear in supporting documentation, and that
                          ' * the name of Silicon Graphics, Inc. not be used in advertising
                          ' * or publicity pertaining to distribution of the software without specific,
                          ' * written prior permission.
                          ' *
                          ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                          ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                          ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                          ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                          ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                          ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                          ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                          ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                          ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                          ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                          ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                          ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                          ' *
                          ' * US Government Users Restricted Rights
                          ' * Use, duplication, or disclosure by the Government is subject to
                          ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                          ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                          ' * clause at DFARS 252.227-7013 and/or in similar or successor
                          ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                          ' * Unpublished-- rights reserved under the copyright laws of the
                          ' * United States.  Contractor/manufacturer is Silicon Graphics,
                          ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                          ' *
                          ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                          ' */
                          
                          '/*
                          ' *  aaindex.c
                          ' *  This program draws shows how to draw anti-aliased lines in color
                          ' *  index mode. It draws two diagonal lines to form an X; when 'r'
                          ' *  is typed in the window, the lines are rotated in opposite
                          ' *  directions.
                          ' */
                          
                          #COMPILE EXE
                          #DIM ALL
                          
                          ' // Include files
                          #INCLUDE ONCE "glu.inc"
                          #INCLUDE ONCE "AfxGlut.inc"
                          
                          $WindowCaption = "DDT OpenGL: robot"
                          
                          GLOBAL pGL AS IDDTOpenGL
                          
                          ' =======================================================================================
                          ' OpenGL class
                          ' =======================================================================================
                          CLASS CDDTOpenGL
                          
                             INSTANCE m_hdc AS DWORD    ' // Device context
                             INSTANCE m_hrc AS DWORD    ' // Rendering context
                             INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                          
                             INSTANCE shoulder AS LONG
                             INSTANCE elbow AS LONG
                          
                             CLASS METHOD Destroy
                                ' // Release the device and rendering contexts
                                IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                ' // Delete the rendering context
                                IF m_hrc THEN wglDeleteContext m_hrc
                                ' // Release the device context
                                IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                             END METHOD
                          
                             ' =====================================================================================
                             INTERFACE IDDTOpenGL : INHERIT IUnknown
                             ' =====================================================================================
                          
                             ' =====================================================================================
                             ' Initializes OpenGL
                             ' =====================================================================================
                             METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                          
                                IF hDlg = 0 THEN EXIT METHOD
                                m_hDlg = hDlg
                          
                                ' // Get the device context
                                m_hdc = GetDC(m_hDlg)
                                IF m_hdc = 0 THEN EXIT METHOD
                          
                                ' // Bits per pixel
                                LOCAL nBitsPerPel AS LONG
                                nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                          
                                ' // Depth bits
                                LOCAL cDepthBits AS LONG
                                cDepthBits = nBitsPerPel - 8
                                IF cDepthBits < 16 THEN cDepthBits = 16
                          
                                ' // Pixel format
                                LOCAL 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
                                LOCAL pf AS LONG
                                pf = ChoosePixelFormat(m_hdc, pfd)
                                IF ISFALSE pf THEN
                                   MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                   EXIT METHOD
                                END IF
                          
                                ' // Set the pixel format
                                IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                   MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                   EXIT METHOD
                                END IF
                          
                                ' // Create a new OpenGL rendering context
                                m_hrc = wglCreateContext(m_hdc)
                                IF m_hrc = 0 THEN
                                   MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                   SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                   EXIT METHOD
                                END IF
                          
                                ' // Make it current
                                IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                   MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                   SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                   EXIT METHOD
                                END IF
                          
                                ' // Return success
                                METHOD = %TRUE
                          
                             END METHOD
                             ' =====================================================================================
                          
                             ' =====================================================================================
                             ' All the setup goes here
                             ' =====================================================================================
                             METHOD SetupScene
                          
                                glClearColor 0.0, 0.0, 0.0, 0.0
                                glShadeModel %GL_FLAT
                          
                             END METHOD
                             ' =====================================================================================
                          
                             ' =====================================================================================
                             ' Resize the scene
                             ' =====================================================================================
                             METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                          
                                glViewport 0, 0, w, h
                                glMatrixMode %GL_PROJECTION
                                glLoadIdentity
                                gluPerspective 65.0, w / h, 1.0, 20.0
                                glMatrixMode %GL_MODELVIEW
                                glLoadIdentity
                                glTranslatef 0.0, 0.0, -5.0
                          
                             END METHOD
                             ' =====================================================================================
                          
                             ' =======================================================================================
                             ' Render the scene
                             ' =======================================================================================
                             METHOD RenderScene
                          
                                glClear %GL_COLOR_BUFFER_BIT
                                glPushMatrix
                                glTranslatef -1.0, 0.0, 0.0
                                glRotatef shoulder, 0.0, 0.0, 1.0
                                glTranslatef 1.0, 0.0, 0.0
                                glPushMatrix
                                glScalef 2.0, 0.4, 1.0
                                AfxGlutWireCube 1.0
                                glPopMatrix
                          
                                glTranslatef 1.0, 0.0, 0.0
                                glRotatef elbow, 0.0, 0.0, 1.0
                                glTranslatef 1.0, 0.0, 0.0
                                glPushMatrix
                                glScalef 2.0, 0.4, 1.0
                                AfxGlutWireCube 1.0
                                glPopMatrix
                          
                                glPopMatrix
                          
                                ' // Exchange the front and back buffers
                                SwapBuffers m_hdc
                          
                             END METHOD
                             ' =======================================================================================
                          
                             ' ====================================================================================
                             ' Processes keystrokes
                             ' ====================================================================================
                             METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                SELECT CASE wMsg
                                   CASE %WM_KEYDOWN
                                      SELECT CASE LO(WORD, wParam)
                                         CASE %VK_ESCAPE
                                            ' // Send a message to close the application
                                            DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                         CASE %VK_S
                                            IF GetAsyncKeyState(%VK_SHIFT) THEN
                                               shoulder = (shoulder - 5) MOD 360
                                            ELSE
                                               shoulder = (shoulder + 5) MOD 360
                                            END IF
                                         CASE %VK_E
                                            IF GetAsyncKeyState(%VK_SHIFT) THEN
                                               elbow = (elbow - 5) MOD 360
                                            ELSE
                                               elbow = (elbow + 5) MOD 360
                                            END IF
                                      END SELECT
                                END SELECT
                             END METHOD
                             ' ====================================================================================
                          
                             END INTERFACE
                          
                          END CLASS
                          ' =======================================================================================
                          
                          ' ========================================================================================
                          ' Main
                          ' ========================================================================================
                          FUNCTION PBMAIN () AS LONG
                          
                             ' // Create the dialog
                             LOCAL hDlg AS DWORD
                             DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                          
                             ' // Create an instance of the DX9 class
                             pGL = CLASS "CDDTOpenGL"
                             IF ISNOTHING(pGL) THEN EXIT FUNCTION
                          
                             ' // Initialize OpenGL
                             IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                          
                             ' // Display and activate the dialog
                             DIALOG SHOW MODELESS hDlg, CALL DlgProc
                          
                             ' // Set the timer
                             SetTimer(hDlg, 1, 0, %NULL)
                          
                             ' // Message loop
                             LOCAL uMsg AS tagMsg
                             WHILE GetMessage(uMsg, %NULL, 0, 0)
                                TranslateMessage uMsg
                                DispatchMessage uMsg
                             WEND
                          
                             ' // Kill the timer
                             KillTimer(hDlg, 1)
                          
                          END FUNCTION
                          ' ========================================================================================
                          
                          ' ========================================================================================
                          ' Main Dialog procedure
                          ' ========================================================================================
                          CALLBACK FUNCTION DlgProc() AS LONG
                          
                             SELECT CASE CB.MSG
                          
                                CASE %WM_SYSCOMMAND
                                   ' // Disable the Windows screensaver
                                   IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                   ' // Close the window
                                   IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                          
                                CASE %WM_INITDIALOG
                                   ' // Set up the scene
                                   pGL.SetupScene
                          
                                CASE %WM_TIMER
                                   ' // Render the scene
                                   pGL.RenderScene
                          
                                CASE %WM_SIZE
                                   ' // Resize the scene
                                   pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                          
                                CASE %WM_KEYDOWN
                                   ' // Process keystrokes
                                   pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                          
                                CASE %WM_CLOSE
                                   ' // Post a message to end the application
                                   DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                          
                                CASE %WM_DESTROY
                                   ' // End the application
                                   ' // Use this method instead of DIALOG END with modeless dialogs
                                   PostQuitMessage 0
                          
                             END SELECT
                          
                          END FUNCTION
                          ' ========================================================================================
                          Attached Files
                          Forum: http://www.jose.it-berater.org/smfforum/index.php

                          Comment


                          • #53
                            OpenGL: scene

                            This program demonstrates the use of the GL lighting model. Objects are drawn using a grey material characteristic. A single light source illuminates the objects.

                            Code:
                            ' ########################################################################################
                            ' Microsoft Windows
                            ' File: EX_DDT_OpenGL_scene.bas
                            ' Compilers: PBWIN 10+, PBCC 6+
                            ' Headers: Windows API headers 3.0+
                            ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                            ' ########################################################################################
                            
                            '/*
                            ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                            ' * ALL RIGHTS RESERVED
                            ' * Permission to use, copy, modify, and distribute this software for
                            ' * any purpose and without fee is hereby granted, provided that the above
                            ' * copyright notice appear in all copies and that both the copyright notice
                            ' * and this permission notice appear in supporting documentation, and that
                            ' * the name of Silicon Graphics, Inc. not be used in advertising
                            ' * or publicity pertaining to distribution of the software without specific,
                            ' * written prior permission.
                            ' *
                            ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                            ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                            ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                            ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                            ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                            ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                            ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                            ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                            ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                            ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                            ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                            ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                            ' *
                            ' * US Government Users Restricted Rights
                            ' * Use, duplication, or disclosure by the Government is subject to
                            ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                            ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                            ' * clause at DFARS 252.227-7013 and/or in similar or successor
                            ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                            ' * Unpublished-- rights reserved under the copyright laws of the
                            ' * United States.  Contractor/manufacturer is Silicon Graphics,
                            ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                            ' *
                            ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                            ' */
                            
                            '/*
                            ' *  scene.c
                            ' *  This program demonstrates the use of the GL lighting model.
                            ' *  Objects are drawn using a grey material characteristic.
                            ' *  A single light source illuminates the objects.
                            ' */
                            
                            #COMPILE EXE
                            #DIM ALL
                            
                            ' // Include files
                            #INCLUDE ONCE "glu.inc"
                            #INCLUDE ONCE "AfxGlut.inc"
                            
                            $WindowCaption = "DDT OpenGL: scene"
                            
                            GLOBAL pGL AS IDDTOpenGL
                            
                            ' =======================================================================================
                            ' OpenGL class
                            ' =======================================================================================
                            CLASS CDDTOpenGL
                            
                               INSTANCE m_hdc AS DWORD    ' // Device context
                               INSTANCE m_hrc AS DWORD    ' // Rendering context
                               INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                            
                               CLASS METHOD Destroy
                                  ' // Release the device and rendering contexts
                                  IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                  ' // Delete the rendering context
                                  IF m_hrc THEN wglDeleteContext m_hrc
                                  ' // Release the device context
                                  IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                               END METHOD
                            
                               ' =====================================================================================
                               INTERFACE IDDTOpenGL : INHERIT IUnknown
                               ' =====================================================================================
                            
                               ' =====================================================================================
                               ' Initializes OpenGL
                               ' =====================================================================================
                               METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                            
                                  IF hDlg = 0 THEN EXIT METHOD
                                  m_hDlg = hDlg
                            
                                  ' // Get the device context
                                  m_hdc = GetDC(m_hDlg)
                                  IF m_hdc = 0 THEN EXIT METHOD
                            
                                  ' // Bits per pixel
                                  LOCAL nBitsPerPel AS LONG
                                  nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                            
                                  ' // Depth bits
                                  LOCAL cDepthBits AS LONG
                                  cDepthBits = nBitsPerPel - 8
                                  IF cDepthBits < 16 THEN cDepthBits = 16
                            
                                  ' // Pixel format
                                  LOCAL 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
                                  LOCAL pf AS LONG
                                  pf = ChoosePixelFormat(m_hdc, pfd)
                                  IF ISFALSE pf THEN
                                     MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                     EXIT METHOD
                                  END IF
                            
                                  ' // Set the pixel format
                                  IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                     MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                     EXIT METHOD
                                  END IF
                            
                                  ' // Create a new OpenGL rendering context
                                  m_hrc = wglCreateContext(m_hdc)
                                  IF m_hrc = 0 THEN
                                     MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                     SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                     EXIT METHOD
                                  END IF
                            
                                  ' // Make it current
                                  IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                     MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                     SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                     EXIT METHOD
                                  END IF
                            
                                  ' // Return success
                                  METHOD = %TRUE
                            
                               END METHOD
                               ' =====================================================================================
                            
                               ' =====================================================================================
                               ' All the setup goes here
                               ' =====================================================================================
                               METHOD SetupScene
                            
                                  DIM light_ambient(3) AS SINGLE
                                  DIM light_diffuse(3) AS SINGLE
                                  DIM light_specular(3) AS SINGLE
                                  DIM light_position(3) AS SINGLE
                            
                                  ARRAY ASSIGN light_ambient() = 0.0, 0.0, 0.0, 1.0
                                  ARRAY ASSIGN light_diffuse() = 1.0, 1.0, 1.0, 1.0
                                  ARRAY ASSIGN light_specular() = 1.0, 1.0, 1.0, 1.0
                                  ' /*	light_position is NOT default value	*/
                                  ARRAY ASSIGN light_position() = 1.0, 1.0, 1.0, 0.0
                            
                                  glLightfv %GL_LIGHT0, %GL_AMBIENT, light_ambient(0)
                                  glLightfv %GL_LIGHT0, %GL_DIFFUSE, light_diffuse(0)
                                  glLightfv %GL_LIGHT0, %GL_SPECULAR, light_specular(0)
                                  glLightfv %GL_LIGHT0, %GL_POSITION, light_position(0)
                            
                                  glEnable %GL_LIGHTING
                                  glEnable %GL_LIGHT0
                                  glEnable %GL_DEPTH_TEST
                            
                               END METHOD
                               ' =====================================================================================
                            
                               ' =====================================================================================
                               ' Resize the scene
                               ' =====================================================================================
                               METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                            
                                  glViewport 0, 0, w, h
                                  glMatrixMode %GL_PROJECTION
                                  glLoadIdentity
                                  IF w <= h THEN
                                     glOrtho -2.5, 2.5, -2.5 * h / w, _
                                             2.5 * h / w, -10.0, 10.0
                                  ELSE
                                     glOrtho -2.5 * w / h, _
                                             2.5 * w / h, -2.5, 2.5, -10.0, 10.0
                                  END IF
                                  glMatrixMode %GL_MODELVIEW
                                  glLoadIdentity
                            
                               END METHOD
                               ' =====================================================================================
                            
                               ' =======================================================================================
                               ' Render the scene
                               ' =======================================================================================
                               METHOD RenderScene
                            
                                  glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                            
                                  glPushMatrix
                                  glRotatef 20.0, 1.0, 0.0, 0.0
                            
                                  glPushMatrix
                                  glTranslatef -0.75, 0.5, 0.0
                                  glRotatef 90.0, 1.0, 0.0, 0.0
                                  AfxGlutSolidTorus 0.275, 0.85, 15, 15
                                  glPopMatrix
                            
                                  glPushMatrix
                                  glTranslatef -0.75, -0.5, 0.0
                                  glRotatef 270.0, 1.0, 0.0, 0.0
                                  AfxGlutSolidCone 1.0, 2.0, 15, 15
                                  glPopMatrix
                            
                                  glPushMatrix
                                  glTranslatef 0.75, 0.0, -1.0
                                  AfxGlutSolidSphere 1.0, 15, 15
                                  glPopMatrix
                            
                                  glPopMatrix
                                  glFlush
                            
                                  ' // Exchange the front and back buffers
                                  SwapBuffers m_hdc
                            
                               END METHOD
                               ' =======================================================================================
                            
                               ' ====================================================================================
                               ' Processes keystrokes
                               ' ====================================================================================
                               METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                  SELECT CASE wMsg
                                     CASE %WM_KEYDOWN
                                        SELECT CASE LO(WORD, wParam)
                                           CASE %VK_ESCAPE
                                              ' // Send a message to close the application
                                              DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                        END SELECT
                                  END SELECT
                               END METHOD
                               ' ====================================================================================
                            
                               END INTERFACE
                            
                            END CLASS
                            ' =======================================================================================
                            
                            ' ========================================================================================
                            ' Main
                            ' ========================================================================================
                            FUNCTION PBMAIN () AS LONG
                            
                               ' // Create the dialog
                               LOCAL hDlg AS DWORD
                               DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                            
                               ' // Create an instance of the DX9 class
                               pGL = CLASS "CDDTOpenGL"
                               IF ISNOTHING(pGL) THEN EXIT FUNCTION
                            
                               ' // Initialize OpenGL
                               IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                            
                               ' // Display and activate the dialog
                               DIALOG SHOW MODELESS hDlg, CALL DlgProc
                            
                               ' // Set the timer
                               SetTimer(hDlg, 1, 0, %NULL)
                            
                               ' // Message loop
                               LOCAL uMsg AS tagMsg
                               WHILE GetMessage(uMsg, %NULL, 0, 0)
                                  TranslateMessage uMsg
                                  DispatchMessage uMsg
                               WEND
                            
                               ' // Kill the timer
                               KillTimer(hDlg, 1)
                            
                            END FUNCTION
                            ' ========================================================================================
                            
                            ' ========================================================================================
                            ' Main Dialog procedure
                            ' ========================================================================================
                            CALLBACK FUNCTION DlgProc() AS LONG
                            
                               SELECT CASE CB.MSG
                            
                                  CASE %WM_SYSCOMMAND
                                     ' // Disable the Windows screensaver
                                     IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                     ' // Close the window
                                     IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                            
                                  CASE %WM_INITDIALOG
                                     ' // Set up the scene
                                     pGL.SetupScene
                            
                                  CASE %WM_TIMER
                                     ' // Render the scene
                                     pGL.RenderScene
                            
                                  CASE %WM_SIZE
                                     ' // Resize the scene
                                     pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                            
                                  CASE %WM_KEYDOWN
                                     ' // Process keystrokes
                                     pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                            
                                  CASE %WM_CLOSE
                                     ' // Post a message to end the application
                                     DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                            
                                  CASE %WM_DESTROY
                                     ' // End the application
                                     ' // Use this method instead of DIALOG END with modeless dialogs
                                     PostQuitMessage 0
                            
                               END SELECT
                            
                            END FUNCTION
                            ' ========================================================================================
                            Attached Files
                            Forum: http://www.jose.it-berater.org/smfforum/index.php

                            Comment


                            • #54
                              OpenGL: smooth

                              This program demonstrates smooth shading. A smooth shaded polygon is drawn in a 2-D projection.

                              Code:
                              ' ########################################################################################
                              ' Microsoft Windows
                              ' File: EX_DDT_OpenGL_smooth.bas
                              ' Compilers: PBWIN 10+, PBCC 6+
                              ' Headers: Windows API headers 3.0+
                              ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                              ' ########################################################################################
                              
                              '/*
                              ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                              ' * ALL RIGHTS RESERVED
                              ' * Permission to use, copy, modify, and distribute this software for
                              ' * any purpose and without fee is hereby granted, provided that the above
                              ' * copyright notice appear in all copies and that both the copyright notice
                              ' * and this permission notice appear in supporting documentation, and that
                              ' * the name of Silicon Graphics, Inc. not be used in advertising
                              ' * or publicity pertaining to distribution of the software without specific,
                              ' * written prior permission.
                              ' *
                              ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                              ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                              ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                              ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                              ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                              ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                              ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                              ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                              ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                              ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                              ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                              ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                              ' *
                              ' * US Government Users Restricted Rights
                              ' * Use, duplication, or disclosure by the Government is subject to
                              ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                              ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                              ' * clause at DFARS 252.227-7013 and/or in similar or successor
                              ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                              ' * Unpublished-- rights reserved under the copyright laws of the
                              ' * United States.  Contractor/manufacturer is Silicon Graphics,
                              ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                              ' *
                              ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                              ' */
                              
                              '/*
                              ' * smooth.c
                              ' * This program demonstrates smooth shading.
                              ' * A smooth shaded polygon is drawn in a 2-D projection.
                              ' */
                              
                              #COMPILE EXE
                              #DIM ALL
                              
                              ' // Include files
                              #INCLUDE ONCE "glu.inc"
                              #INCLUDE ONCE "AfxGlut.inc"
                              
                              $WindowCaption = "DDT OpenGL: smooth"
                              
                              GLOBAL pGL AS IDDTOpenGL
                              
                              ' =======================================================================================
                              ' OpenGL class
                              ' =======================================================================================
                              CLASS CDDTOpenGL
                              
                                 INSTANCE m_hdc AS DWORD    ' // Device context
                                 INSTANCE m_hrc AS DWORD    ' // Rendering context
                                 INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                              
                                 CLASS METHOD Destroy
                                    ' // Release the device and rendering contexts
                                    IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                    ' // Delete the rendering context
                                    IF m_hrc THEN wglDeleteContext m_hrc
                                    ' // Release the device context
                                    IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                 END METHOD
                              
                                 ' =====================================================================================
                                 INTERFACE IDDTOpenGL : INHERIT IUnknown
                                 ' =====================================================================================
                              
                                 ' =====================================================================================
                                 ' Initializes OpenGL
                                 ' =====================================================================================
                                 METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                              
                                    IF hDlg = 0 THEN EXIT METHOD
                                    m_hDlg = hDlg
                              
                                    ' // Get the device context
                                    m_hdc = GetDC(m_hDlg)
                                    IF m_hdc = 0 THEN EXIT METHOD
                              
                                    ' // Bits per pixel
                                    LOCAL nBitsPerPel AS LONG
                                    nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                              
                                    ' // Depth bits
                                    LOCAL cDepthBits AS LONG
                                    cDepthBits = nBitsPerPel - 8
                                    IF cDepthBits < 16 THEN cDepthBits = 16
                              
                                    ' // Pixel format
                                    LOCAL 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
                                    LOCAL pf AS LONG
                                    pf = ChoosePixelFormat(m_hdc, pfd)
                                    IF ISFALSE pf THEN
                                       MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                       EXIT METHOD
                                    END IF
                              
                                    ' // Set the pixel format
                                    IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                       MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                       EXIT METHOD
                                    END IF
                              
                                    ' // Create a new OpenGL rendering context
                                    m_hrc = wglCreateContext(m_hdc)
                                    IF m_hrc = 0 THEN
                                       MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                       SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                       EXIT METHOD
                                    END IF
                              
                                    ' // Make it current
                                    IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                       MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                       SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                       EXIT METHOD
                                    END IF
                              
                                    ' // Return success
                                    METHOD = %TRUE
                              
                                 END METHOD
                                 ' =====================================================================================
                              
                                 ' =====================================================================================
                                 ' All the setup goes here
                                 ' =====================================================================================
                                 METHOD SetupScene
                              
                                    glClearColor 0.0, 0.0, 0.0, 0.0
                                    glShadeModel %GL_SMOOTH
                              
                                 END METHOD
                                 ' =====================================================================================
                              
                                 ' =====================================================================================
                                 ' Resize the scene
                                 ' =====================================================================================
                                 METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                              
                                    glViewport 0, 0, w, h
                                    glMatrixMode %GL_PROJECTION
                                    glLoadIdentity
                                    IF w <= h THEN
                                       gluOrtho2D 0.0, 30.0, 0.0, 30.0 * h / w
                                    ELSE
                                       gluOrtho2D 0.0, 30.0 * w / h, 0.0, 30.0
                                    END IF
                                    glMatrixMode %GL_MODELVIEW
                              
                                 END METHOD
                                 ' =====================================================================================
                              
                                 ' ========================================================================================
                                 ' Draw the triangle
                                 ' ========================================================================================
                                 METHOD triangle()
                              
                                    glBegin %GL_TRIANGLES
                                    glColor3f 1.0, 0.0, 0.0
                                    glVertex2f 5.0, 5.0
                                    glColor3f 0.0, 1.0, 0.0
                                    glVertex2f 25.0, 5.0
                                    glColor3f 0.0, 0.0, 1.0
                                    glVertex2f 5.0, 25.0
                                    glEnd
                              
                                 END METHOD
                                 ' ========================================================================================
                              
                                 ' =======================================================================================
                                 ' Render the scene
                                 ' =======================================================================================
                                 METHOD RenderScene
                              
                                    glClear %GL_COLOR_BUFFER_BIT
                                    ME.triangle
                                    glFlush
                              
                                    ' // Exchange the front and back buffers
                                    SwapBuffers m_hdc
                              
                                 END METHOD
                                 ' =======================================================================================
                              
                                 ' ====================================================================================
                                 ' Processes keystrokes
                                 ' ====================================================================================
                                 METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                    SELECT CASE wMsg
                                       CASE %WM_KEYDOWN
                                          SELECT CASE LO(WORD, wParam)
                                             CASE %VK_ESCAPE
                                                ' // Send a message to close the application
                                                DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                          END SELECT
                                    END SELECT
                                 END METHOD
                                 ' ====================================================================================
                              
                                 END INTERFACE
                              
                              END CLASS
                              ' =======================================================================================
                              
                              ' ========================================================================================
                              ' Main
                              ' ========================================================================================
                              FUNCTION PBMAIN () AS LONG
                              
                                 ' // Create the dialog
                                 LOCAL hDlg AS DWORD
                                 DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                              
                                 ' // Create an instance of the DX9 class
                                 pGL = CLASS "CDDTOpenGL"
                                 IF ISNOTHING(pGL) THEN EXIT FUNCTION
                              
                                 ' // Initialize OpenGL
                                 IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                              
                                 ' // Display and activate the dialog
                                 DIALOG SHOW MODELESS hDlg, CALL DlgProc
                              
                                 ' // Set the timer
                                 SetTimer(hDlg, 1, 0, %NULL)
                              
                                 ' // Message loop
                                 LOCAL uMsg AS tagMsg
                                 WHILE GetMessage(uMsg, %NULL, 0, 0)
                                    TranslateMessage uMsg
                                    DispatchMessage uMsg
                                 WEND
                              
                                 ' // Kill the timer
                                 KillTimer(hDlg, 1)
                              
                              END FUNCTION
                              ' ========================================================================================
                              
                              ' ========================================================================================
                              ' Main Dialog procedure
                              ' ========================================================================================
                              CALLBACK FUNCTION DlgProc() AS LONG
                              
                                 SELECT CASE CB.MSG
                              
                                    CASE %WM_SYSCOMMAND
                                       ' // Disable the Windows screensaver
                                       IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                       ' // Close the window
                                       IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                              
                                    CASE %WM_INITDIALOG
                                       ' // Set up the scene
                                       pGL.SetupScene
                              
                                    CASE %WM_TIMER
                                       ' // Render the scene
                                       pGL.RenderScene
                              
                                    CASE %WM_SIZE
                                       ' // Resize the scene
                                       pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                              
                                    CASE %WM_KEYDOWN
                                       ' // Process keystrokes
                                       pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                              
                                    CASE %WM_CLOSE
                                       ' // Post a message to end the application
                                       DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                              
                                    CASE %WM_DESTROY
                                       ' // End the application
                                       ' // Use this method instead of DIALOG END with modeless dialogs
                                       PostQuitMessage 0
                              
                                 END SELECT
                              
                              END FUNCTION
                              ' ========================================================================================
                              Attached Files
                              Forum: http://www.jose.it-berater.org/smfforum/index.php

                              Comment


                              • #55
                                OpenGL: surface

                                This program draws a NURBS surface in the shape of a symmetrical hill. The 'c' keyboard key allows you to toggle the visibility of the control points themselves. Note that some of the control points are hidden by the surface itself.

                                Code:
                                ' ########################################################################################
                                ' Microsoft Windows
                                ' File: EX_DDT_OpenGL_surface.bas
                                ' Compilers: PBWIN 10+, PBCC 6+
                                ' Headers: Windows API headers 3.0+
                                ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                                ' ########################################################################################
                                
                                '/*
                                ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                                ' * ALL RIGHTS RESERVED
                                ' * Permission to use, copy, modify, and distribute this software for
                                ' * any purpose and without fee is hereby granted, provided that the above
                                ' * copyright notice appear in all copies and that both the copyright notice
                                ' * and this permission notice appear in supporting documentation, and that
                                ' * the name of Silicon Graphics, Inc. not be used in advertising
                                ' * or publicity pertaining to distribution of the software without specific,
                                ' * written prior permission.
                                ' *
                                ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                                ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                                ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                                ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                                ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                                ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                                ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                                ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                                ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                                ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                                ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                                ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                                ' *
                                ' * US Government Users Restricted Rights
                                ' * Use, duplication, or disclosure by the Government is subject to
                                ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                                ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                                ' * clause at DFARS 252.227-7013 and/or in similar or successor
                                ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                                ' * Unpublished-- rights reserved under the copyright laws of the
                                ' * United States.  Contractor/manufacturer is Silicon Graphics,
                                ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                                ' *
                                ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                                ' */
                                
                                '/*
                                ' *  surface.c
                                ' *  This program draws a NURBS surface in the shape of a
                                ' *  symmetrical hill.  The 'c' keyboard key allows you to
                                ' *  toggle the visibility of the control points themselves.
                                ' *  Note that some of the control points are hidden by the
                                ' *  surface itself.
                                ' */
                                
                                #COMPILE EXE
                                #DIM ALL
                                
                                ' // Include files
                                #INCLUDE ONCE "glu.inc"
                                
                                $WindowCaption = "DDT OpenGL: surface"
                                
                                GLOBAL pGL AS IDDTOpenGL
                                
                                ' =======================================================================================
                                ' OpenGL class
                                ' =======================================================================================
                                CLASS CDDTOpenGL
                                
                                   INSTANCE m_hdc AS DWORD    ' // Device context
                                   INSTANCE m_hrc AS DWORD    ' // Rendering context
                                   INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                                
                                   INSTANCE ctlpoints () AS SINGLE
                                   INSTANCE showPoints AS LONG
                                   INSTANCE theNurb AS DWORD
                                
                                   CLASS METHOD Destroy
                                      ' // Release the device and rendering contexts
                                      IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                      ' // Delete the rendering context
                                      IF m_hrc THEN wglDeleteContext m_hrc
                                      ' // Release the device context
                                      IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                   END METHOD
                                
                                   ' =====================================================================================
                                   INTERFACE IDDTOpenGL : INHERIT IUnknown
                                   ' =====================================================================================
                                
                                   ' =====================================================================================
                                   ' Initializes OpenGL
                                   ' =====================================================================================
                                   METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                                
                                      IF hDlg = 0 THEN EXIT METHOD
                                      m_hDlg = hDlg
                                
                                      ' // Get the device context
                                      m_hdc = GetDC(m_hDlg)
                                      IF m_hdc = 0 THEN EXIT METHOD
                                
                                      ' // Bits per pixel
                                      LOCAL nBitsPerPel AS LONG
                                      nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                                
                                      ' // Depth bits
                                      LOCAL cDepthBits AS LONG
                                      cDepthBits = nBitsPerPel - 8
                                      IF cDepthBits < 16 THEN cDepthBits = 16
                                
                                      ' // Pixel format
                                      LOCAL 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
                                      LOCAL pf AS LONG
                                      pf = ChoosePixelFormat(m_hdc, pfd)
                                      IF ISFALSE pf THEN
                                         MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                         EXIT METHOD
                                      END IF
                                
                                      ' // Set the pixel format
                                      IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                         MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                         EXIT METHOD
                                      END IF
                                
                                      ' // Create a new OpenGL rendering context
                                      m_hrc = wglCreateContext(m_hdc)
                                      IF m_hrc = 0 THEN
                                         MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                         SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                         EXIT METHOD
                                      END IF
                                
                                      ' // Make it current
                                      IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                         MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                         SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                         EXIT METHOD
                                      END IF
                                
                                      ' // Return success
                                      METHOD = %TRUE
                                
                                   END METHOD
                                   ' =====================================================================================
                                
                                   ' =====================================================================================
                                   ' All the setup goes here
                                   ' =====================================================================================
                                   METHOD SetupScene
                                
                                      DIM mat_diffuse(3) AS SINGLE
                                      DIM mat_specular(3) AS SINGLE
                                      DIM mat_shininess(0) AS SINGLE
                                
                                      ARRAY ASSIGN mat_diffuse() = 0.7, 0.7, 0.7, 1.0
                                      ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
                                      ARRAY ASSIGN mat_shininess() = 100.0
                                
                                      glClearColor 0.0, 0.0, 0.0, 0.0
                                      glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                                      glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                                      glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
                                
                                      glEnable %GL_LIGHTING
                                      glEnable %GL_LIGHT0
                                      glEnable %GL_DEPTH_TEST
                                      glEnable %GL_AUTO_NORMAL
                                      glEnable %GL_NORMALIZE
                                
                                      ' // Init surface
                                      LOCAL u, v AS LONG
                                      DIM ctlpoints(2, 3, 3) AS INSTANCE SINGLE
                                      FOR u = 0 TO 3
                                         FOR v = 0 TO 3
                                            ctlpoints(0, v, u) = 2.0 * (u - 1.5)
                                            ctlpoints(1, v, u) = 2.0 * (v - 1.5)
                                
                                            IF (u = 1 OR u = 2) AND (v = 1 OR v = 2) THEN
                                               ctlpoints(2, v, u) = 3.0
                                            ELSE
                                               ctlpoints(2, v, 8)= -3.0
                                            END IF
                                         NEXT
                                      NEXT
                                
                                      theNurb = gluNewNurbsRenderer
                                      gluNurbsProperty theNurb, %GLU_SAMPLING_TOLERANCE, 25.0
                                      gluNurbsProperty theNurb, %GLU_DISPLAY_MODE, %GLU_FILL
                                
                                   END METHOD
                                   ' =====================================================================================
                                
                                   ' =====================================================================================
                                   ' Resize the scene
                                   ' =====================================================================================
                                   METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                                
                                      glViewport 0, 0, w, h
                                      glMatrixMode %GL_PROJECTION
                                      glLoadIdentity
                                      gluPerspective 45.0, w / h, 3.0, 8.0
                                
                                      glMatrixMode %GL_MODELVIEW
                                      glLoadIdentity
                                      glTranslatef 0.0, 0.0, -5.0
                                
                                   END METHOD
                                   ' =====================================================================================
                                
                                   ' =======================================================================================
                                   ' Render the scene
                                   ' =======================================================================================
                                   METHOD RenderScene
                                
                                      GLOBAL i, j AS LONG
                                
                                      DIM knots(7) AS SINGLE
                                      ARRAY ASSIGN knots() = 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0
                                
                                      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                                      glPushMatrix
                                      glRotatef 330.0, 1.0, 0.0, 0.0
                                      glScalef  0.5, 0.5, 0.5
                                
                                      gluBeginSurface theNurb
                                      gluNurbsSurface theNurb, _
                                                      8, knots(0), 8, knots(0), _
                                                      4 * 3, 3, ctlpoints(0, 0, 0), _
                                                      4, 4, %GL_MAP2_VERTEX_3
                                      gluEndSurface theNurb
                                
                                      IF showPoints THEN
                                         glPointSize 5.0
                                         glDisable %GL_LIGHTING
                                         glColor3f 1.0, 1.0, 0.0
                                         glBegin %GL_POINTS
                                         FOR i = 0 TO 3
                                            FOR j = 0 TO 3
                                               glVertex3f ctlpoints(0, j, i), _
                                                       ctlpoints(1, j, i), ctlpoints(2, j, i)
                                            NEXT
                                         NEXT
                                         glEnd
                                         glEnable %GL_LIGHTING
                                      END IF
                                      glPopMatrix
                                      glFlush
                                
                                      ' // Exchange the front and back buffers
                                      SwapBuffers m_hdc
                                
                                   END METHOD
                                   ' =======================================================================================
                                
                                   ' ====================================================================================
                                   ' Processes keystrokes
                                   ' ====================================================================================
                                   METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                      SELECT CASE wMsg
                                         CASE %WM_KEYDOWN
                                            SELECT CASE LO(WORD, wParam)
                                               CASE %VK_ESCAPE
                                                  ' // Send a message to close the application
                                                  DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                            END SELECT
                                      END SELECT
                                   END METHOD
                                   ' ====================================================================================
                                
                                   END INTERFACE
                                
                                END CLASS
                                ' =======================================================================================
                                
                                ' ========================================================================================
                                ' Main
                                ' ========================================================================================
                                FUNCTION PBMAIN () AS LONG
                                
                                   ' // Create the dialog
                                   LOCAL hDlg AS DWORD
                                   DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                                
                                   ' // Create an instance of the DX9 class
                                   pGL = CLASS "CDDTOpenGL"
                                   IF ISNOTHING(pGL) THEN EXIT FUNCTION
                                
                                   ' // Initialize OpenGL
                                   IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                                
                                   ' // Display and activate the dialog
                                   DIALOG SHOW MODELESS hDlg, CALL DlgProc
                                
                                   ' // Set the timer
                                   SetTimer(hDlg, 1, 0, %NULL)
                                
                                   ' // Message loop
                                   LOCAL uMsg AS tagMsg
                                   WHILE GetMessage(uMsg, %NULL, 0, 0)
                                      TranslateMessage uMsg
                                      DispatchMessage uMsg
                                   WEND
                                
                                   ' // Kill the timer
                                   KillTimer(hDlg, 1)
                                
                                END FUNCTION
                                ' ========================================================================================
                                
                                ' ========================================================================================
                                ' Main Dialog procedure
                                ' ========================================================================================
                                CALLBACK FUNCTION DlgProc() AS LONG
                                
                                   SELECT CASE CB.MSG
                                
                                      CASE %WM_SYSCOMMAND
                                         ' // Disable the Windows screensaver
                                         IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                         ' // Close the window
                                         IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                                
                                      CASE %WM_INITDIALOG
                                         ' // Set up the scene
                                         pGL.SetupScene
                                
                                      CASE %WM_TIMER
                                         ' // Render the scene
                                         pGL.RenderScene
                                
                                      CASE %WM_SIZE
                                         ' // Resize the scene
                                         pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                                
                                      CASE %WM_KEYDOWN
                                         ' // Process keystrokes
                                         pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                                
                                      CASE %WM_CLOSE
                                         ' // Post a message to end the application
                                         DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                                
                                      CASE %WM_DESTROY
                                         ' // End the application
                                         ' // Use this method instead of DIALOG END with modeless dialogs
                                         PostQuitMessage 0
                                
                                   END SELECT
                                
                                END FUNCTION
                                ' ========================================================================================
                                Attached Files
                                Forum: http://www.jose.it-berater.org/smfforum/index.php

                                Comment


                                • #56
                                  OpenGL: teapots

                                  This program demonstrates lots of material properties. A single light source illuminates the objects.

                                  Code:
                                  ' ########################################################################################
                                  ' Microsoft Windows
                                  ' File: EX_DDT_OpenGL_teapots.bas
                                  ' Compilers: PBWIN 10+, PBCC 6+
                                  ' Headers: Windows API headers 3.0+
                                  ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                                  ' ########################################################################################
                                  
                                  '/*
                                  ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                                  ' * ALL RIGHTS RESERVED
                                  ' * Permission to use, copy, modify, and distribute this software for
                                  ' * any purpose and without fee is hereby granted, provided that the above
                                  ' * copyright notice appear in all copies and that both the copyright notice
                                  ' * and this permission notice appear in supporting documentation, and that
                                  ' * the name of Silicon Graphics, Inc. not be used in advertising
                                  ' * or publicity pertaining to distribution of the software without specific,
                                  ' * written prior permission.
                                  ' *
                                  ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                                  ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                                  ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                                  ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                                  ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                                  ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                                  ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                                  ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                                  ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                                  ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                                  ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                                  ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                                  ' *
                                  ' * US Government Users Restricted Rights
                                  ' * Use, duplication, or disclosure by the Government is subject to
                                  ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                                  ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                                  ' * clause at DFARS 252.227-7013 and/or in similar or successor
                                  ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                                  ' * Unpublished-- rights reserved under the copyright laws of the
                                  ' * United States.  Contractor/manufacturer is Silicon Graphics,
                                  ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                                  ' *
                                  ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                                  ' */
                                  
                                  '/*
                                  ' *  teapots.c
                                  ' *  This program demonstrates lots of material properties.
                                  ' *  A single light source illuminates the objects.
                                  ' */
                                  
                                  #COMPILE EXE
                                  #DIM ALL
                                  
                                  ' // Include files
                                  #INCLUDE ONCE "glu.inc"
                                  #INCLUDE ONCE "AfxGlut.inc"
                                  
                                  $WindowCaption = "DDT OpenGL: teapots"
                                  
                                  GLOBAL pGL AS IDDTOpenGL
                                  
                                  ' =======================================================================================
                                  ' OpenGL class
                                  ' =======================================================================================
                                  CLASS CDDTOpenGL
                                  
                                     INSTANCE m_hdc AS DWORD    ' // Device context
                                     INSTANCE m_hrc AS DWORD    ' // Rendering context
                                     INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                                  
                                     INSTANCE teapotList AS DWORD
                                  
                                     CLASS METHOD Destroy
                                        ' // Release the device and rendering contexts
                                        IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                        ' // Delete the rendering context
                                        IF m_hrc THEN wglDeleteContext m_hrc
                                        ' // Release the device context
                                        IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                     END METHOD
                                  
                                     ' =====================================================================================
                                     INTERFACE IDDTOpenGL : INHERIT IUnknown
                                     ' =====================================================================================
                                  
                                     ' =====================================================================================
                                     ' Initializes OpenGL
                                     ' =====================================================================================
                                     METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                                  
                                        IF hDlg = 0 THEN EXIT METHOD
                                        m_hDlg = hDlg
                                  
                                        ' // Get the device context
                                        m_hdc = GetDC(m_hDlg)
                                        IF m_hdc = 0 THEN EXIT METHOD
                                  
                                        ' // Bits per pixel
                                        LOCAL nBitsPerPel AS LONG
                                        nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                                  
                                        ' // Depth bits
                                        LOCAL cDepthBits AS LONG
                                        cDepthBits = nBitsPerPel - 8
                                        IF cDepthBits < 16 THEN cDepthBits = 16
                                  
                                        ' // Pixel format
                                        LOCAL 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
                                        LOCAL pf AS LONG
                                        pf = ChoosePixelFormat(m_hdc, pfd)
                                        IF ISFALSE pf THEN
                                           MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                           EXIT METHOD
                                        END IF
                                  
                                        ' // Set the pixel format
                                        IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                           MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                           EXIT METHOD
                                        END IF
                                  
                                        ' // Create a new OpenGL rendering context
                                        m_hrc = wglCreateContext(m_hdc)
                                        IF m_hrc = 0 THEN
                                           MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                           SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                           EXIT METHOD
                                        END IF
                                  
                                        ' // Make it current
                                        IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                           MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                           SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                           EXIT METHOD
                                        END IF
                                  
                                        ' // Return success
                                        METHOD = %TRUE
                                  
                                     END METHOD
                                     ' =====================================================================================
                                  
                                     ' =====================================================================================
                                     ' * Initialize depth buffer, projection matrix, light source, and lighting
                                     ' * model.  Do not specify a material property here.
                                     ' =====================================================================================
                                     METHOD SetupScene
                                  
                                        DIM ambient(3) AS SINGLE
                                        DIM diffuse(3) AS SINGLE
                                        DIM specular(3) AS SINGLE
                                        DIM position(3) AS SINGLE
                                        DIM lmodel_ambient(3) AS SINGLE
                                        DIM local_view(0) AS SINGLE
                                  
                                        ARRAY ASSIGN ambient() = 0.0, 0.0, 0.0, 1.0
                                        ARRAY ASSIGN diffuse() = 1.0, 1.0, 1.0, 1.0
                                        ARRAY ASSIGN specular() = 1.0, 1.0, 1.0, 1.0
                                        ARRAY ASSIGN position() = 0.0, 3.0, 3.0, 0.0
                                  
                                        ARRAY ASSIGN lmodel_ambient() = 0.2, 0.2, 0.2, 1.0
                                        ARRAY ASSIGN local_view() = 0.0
                                  
                                        glLightfv %GL_LIGHT0, %GL_AMBIENT, ambient(0)
                                        glLightfv %GL_LIGHT0, %GL_DIFFUSE, diffuse(0)
                                        glLightfv %GL_LIGHT0, %GL_POSITION, position(0)
                                        glLightModelfv %GL_LIGHT_MODEL_AMBIENT, lmodel_ambient(0)
                                        glLightModelfv %GL_LIGHT_MODEL_LOCAL_VIEWER, local_view(0)
                                  
                                        glFrontFace %GL_CW
                                        glEnable %GL_LIGHTING
                                        glEnable %GL_LIGHT0
                                        glEnable %GL_AUTO_NORMAL
                                        glEnable %GL_NORMALIZE
                                        glEnable %GL_DEPTH_TEST
                                        ' /*  be efficient--make teapot display list  */
                                        teapotList = glGenLists(1)
                                        glNewList teapotList, %GL_COMPILE
                                        AfxGlutSolidTeapot 1.0
                                        glEndList
                                  
                                     END METHOD
                                     ' =====================================================================================
                                  
                                     ' =====================================================================================
                                     ' Resize the scene
                                     ' =====================================================================================
                                     METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                                  
                                        glViewport 0, 0, w, h
                                        glMatrixMode %GL_PROJECTION
                                        glLoadIdentity
                                        IF w <= h THEN
                                           glOrtho 0.0, 16.0, 0.0, 16.0 * h / w, -10.0, 10.0
                                        ELSE
                                           glOrtho 0.0, 16.0 * w / h, 0.0, 16.0, -10.0, 10.0
                                        END IF
                                        glMatrixMode %GL_MODELVIEW
                                  
                                     END METHOD
                                     ' =====================================================================================
                                  
                                     ' =======================================================================================
                                     ' * Move object into position.  Use 3rd through 12th
                                     ' * parameters to specify the material property.  Draw a teapot.
                                     ' =======================================================================================
                                     METHOD renderTeapot(BYVAL x AS SINGLE, BYVAL y AS SINGLE, _
                                        BYVAL ambr AS SINGLE, BYVAL ambg AS SINGLE, BYVAL ambb AS SINGLE, _
                                        BYVAL difr AS SINGLE, BYVAL difg AS SINGLE, BYVAL difb AS SINGLE, _
                                        BYVAL specr AS SINGLE, BYVAL specg AS SINGLE, BYVAL specb AS SINGLE, BYVAL shine AS SINGLE)
                                  
                                        DIM matx(3) AS SINGLE
                                  
                                        glPushMatrix
                                        glTranslatef x, y, 0.0
                                        matx(0) = ambr : matx(1) = ambg : matx(2) = ambb : matx(3) = 1.0
                                        glMaterialfv %GL_FRONT, %GL_AMBIENT, matx(0)
                                        matx (0) = difr : matx(1) = difg : matx(2) = difb
                                        glMaterialfv %GL_FRONT, %GL_DIFFUSE, matx(0)
                                        matx(0) = specr : matx(1) = specg : matx(2) = specb
                                        glMaterialfv %GL_FRONT, %GL_SPECULAR, matx(0)
                                        glMaterialf %GL_FRONT, %GL_SHININESS, shine * 128.0
                                        glCallList teapotList
                                        glPopMatrix
                                  
                                     END METHOD
                                     ' =======================================================================================
                                  
                                     ' =======================================================================================
                                     ' Render the scene
                                     ' =======================================================================================
                                     METHOD RenderScene
                                  
                                        glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                                        ME.renderTeapot(2.0, 17.0, 0.0215, 0.1745, 0.0215, _
                                           0.07568, 0.61424, 0.07568, 0.633, 0.727811, 0.633, 0.6)
                                        ME.renderTeapot(2.0, 14.0, 0.135, 0.2225, 0.1575, _
                                           0.54, 0.89, 0.63, 0.316228, 0.316228, 0.316228, 0.1)
                                        ME.renderTeapot(2.0, 11.0, 0.05375, 0.05, 0.06625, _
                                           0.18275, 0.17, 0.22525, 0.332741, 0.328634, 0.346435, 0.3)
                                        ME.renderTeapot(2.0, 8.0, 0.25, 0.20725, 0.20725, _
                                           1, 0.829, 0.829, 0.296648, 0.296648, 0.296648, 0.088)
                                        ME.renderTeapot(2.0, 5.0, 0.1745, 0.01175, 0.01175, _
                                           0.61424, 0.04136, 0.04136, 0.727811, 0.626959, 0.626959, 0.6)
                                        ME.renderTeapot(2.0, 2.0, 0.1, 0.18725, 0.1745, _
                                           0.396, 0.74151, 0.69102, 0.297254, 0.30829, 0.306678, 0.1)
                                        ME.renderTeapot(6.0, 17.0, 0.329412, 0.223529, 0.027451, _
                                           0.780392, 0.568627, 0.113725, 0.992157, 0.941176, 0.807843, _
                                           0.21794872)
                                        ME.renderTeapot(6.0, 14.0, 0.2125, 0.1275, 0.054, _
                                           0.714, 0.4284, 0.18144, 0.393548, 0.271906, 0.166721, 0.2)
                                        ME.renderTeapot(6.0, 11.0, 0.25, 0.25, 0.25, _
                                           0.4, 0.4, 0.4, 0.774597, 0.774597, 0.774597, 0.6)
                                        ME.renderTeapot(6.0, 8.0, 0.19125, 0.0735, 0.0225, _
                                           0.7038, 0.27048, 0.0828, 0.256777, 0.137622, 0.086014, 0.1)
                                        ME.renderTeapot(6.0, 5.0, 0.24725, 0.1995, 0.0745, _
                                           0.75164, 0.60648, 0.22648, 0.628281, 0.555802, 0.366065, 0.4)
                                        ME.renderTeapot(6.0, 2.0, 0.19225, 0.19225, 0.19225, _
                                           0.50754, 0.50754, 0.50754, 0.508273, 0.508273, 0.508273, 0.4)
                                        ME.renderTeapot(10.0, 17.0, 0.0, 0.0, 0.0, 0.01, 0.01, 0.01, _
                                           0.50, 0.50, 0.50, .25)
                                        ME.renderTeapot(10.0, 14.0, 0.0, 0.1, 0.06, 0.0, 0.50980392, 0.50980392, _
                                           0.50196078, 0.50196078, 0.50196078, .25)
                                        ME.renderTeapot(10.0, 11.0, 0.0, 0.0, 0.0, _
                                           0.1, 0.35, 0.1, 0.45, 0.55, 0.45, .25)
                                        ME.renderTeapot(10.0, 8.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, _
                                           0.7, 0.6, 0.6, .25)
                                        ME.renderTeapot(10.0, 5.0, 0.0, 0.0, 0.0, 0.55, 0.55, 0.55, _
                                           0.70, 0.70, 0.70, .25)
                                        ME.renderTeapot(10.0, 2.0, 0.0, 0.0, 0.0, 0.5, 0.5, 0.0, _
                                           0.60, 0.60, 0.50, .25)
                                        ME.renderTeapot(14.0, 17.0, 0.02, 0.02, 0.02, 0.01, 0.01, 0.01, _
                                           0.4, 0.4, 0.4, .078125)
                                        ME.renderTeapot(14.0, 14.0, 0.0, 0.05, 0.05, 0.4, 0.5, 0.5, _
                                           0.04, 0.7, 0.7, .078125)
                                        ME.renderTeapot(14.0, 11.0, 0.0, 0.05, 0.0, 0.4, 0.5, 0.4, _
                                           0.04, 0.7, 0.04, .078125)
                                        ME.renderTeapot(14.0, 8.0, 0.05, 0.0, 0.0, 0.5, 0.4, 0.4, _
                                           0.7, 0.04, 0.04, .078125)
                                        ME.renderTeapot(14.0, 5.0, 0.05, 0.05, 0.05, 0.5, 0.5, 0.5, _
                                           0.7, 0.7, 0.7, .078125)
                                        ME.renderTeapot(14.0, 2.0, 0.05, 0.05, 0.0, 0.5, 0.5, 0.4, _
                                           0.7, 0.7, 0.04, .078125)
                                        glFlush
                                  
                                        ' // Exchange the front and back buffers
                                        SwapBuffers m_hdc
                                  
                                     END METHOD
                                     ' =======================================================================================
                                  
                                     ' ====================================================================================
                                     ' Processes keystrokes
                                     ' ====================================================================================
                                     METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                        SELECT CASE wMsg
                                           CASE %WM_KEYDOWN
                                              SELECT CASE LO(WORD, wParam)
                                                 CASE %VK_ESCAPE
                                                    ' // Send a message to close the application
                                                    DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                              END SELECT
                                        END SELECT
                                     END METHOD
                                     ' ====================================================================================
                                  
                                     END INTERFACE
                                  
                                  END CLASS
                                  ' =======================================================================================
                                  
                                  ' ========================================================================================
                                  ' Main
                                  ' ========================================================================================
                                  FUNCTION PBMAIN () AS LONG
                                  
                                     ' // Create the dialog
                                     LOCAL hDlg AS DWORD
                                     DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                                  
                                     ' // Create an instance of the DX9 class
                                     pGL = CLASS "CDDTOpenGL"
                                     IF ISNOTHING(pGL) THEN EXIT FUNCTION
                                  
                                     ' // Initialize OpenGL
                                     IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                                  
                                     ' // Display and activate the dialog
                                     DIALOG SHOW MODELESS hDlg, CALL DlgProc
                                  
                                     ' // Set the timer
                                     SetTimer(hDlg, 1, 0, %NULL)
                                  
                                     ' // Message loop
                                     LOCAL uMsg AS tagMsg
                                     WHILE GetMessage(uMsg, %NULL, 0, 0)
                                        TranslateMessage uMsg
                                        DispatchMessage uMsg
                                     WEND
                                  
                                     ' // Kill the timer
                                     KillTimer(hDlg, 1)
                                  
                                  END FUNCTION
                                  ' ========================================================================================
                                  
                                  ' ========================================================================================
                                  ' Main Dialog procedure
                                  ' ========================================================================================
                                  CALLBACK FUNCTION DlgProc() AS LONG
                                  
                                     SELECT CASE CB.MSG
                                  
                                        CASE %WM_SYSCOMMAND
                                           ' // Disable the Windows screensaver
                                           IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                           ' // Close the window
                                           IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                                  
                                        CASE %WM_INITDIALOG
                                           ' // Set up the scene
                                           pGL.SetupScene
                                  
                                        CASE %WM_TIMER
                                           ' // Render the scene
                                           pGL.RenderScene
                                  
                                        CASE %WM_SIZE
                                           ' // Resize the scene
                                           pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                                  
                                        CASE %WM_KEYDOWN
                                           ' // Process keystrokes
                                           pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                                  
                                        CASE %WM_CLOSE
                                           ' // Post a message to end the application
                                           DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                                  
                                        CASE %WM_DESTROY
                                           ' // End the application
                                           ' // Use this method instead of DIALOG END with modeless dialogs
                                           PostQuitMessage 0
                                  
                                     END SELECT
                                  
                                  END FUNCTION
                                  ' ========================================================================================
                                  Attached Files
                                  Forum: http://www.jose.it-berater.org/smfforum/index.php

                                  Comment


                                  • #57
                                    OpenGL: texturesurf

                                    This program uses evaluators to generate a curved surface and automatically generated texture coordinates.

                                    Code:
                                    ' ########################################################################################
                                    ' Microsoft Windows
                                    ' File: EX_DDT_OpenGL_texturesurf.bas
                                    ' Compilers: PBWIN 10+, PBCC 6+
                                    ' Headers: Windows API headers 3.0+
                                    ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                                    ' ########################################################################################
                                    
                                    '/*
                                    ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                                    ' * ALL RIGHTS RESERVED
                                    ' * Permission to use, copy, modify, and distribute this software for
                                    ' * any purpose and without fee is hereby granted, provided that the above
                                    ' * copyright notice appear in all copies and that both the copyright notice
                                    ' * and this permission notice appear in supporting documentation, and that
                                    ' * the name of Silicon Graphics, Inc. not be used in advertising
                                    ' * or publicity pertaining to distribution of the software without specific,
                                    ' * written prior permission.
                                    ' *
                                    ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                                    ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                                    ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                                    ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                                    ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                                    ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                                    ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                                    ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                                    ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                                    ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                                    ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                                    ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                                    ' *
                                    ' * US Government Users Restricted Rights
                                    ' * Use, duplication, or disclosure by the Government is subject to
                                    ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                                    ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                                    ' * clause at DFARS 252.227-7013 and/or in similar or successor
                                    ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                                    ' * Unpublished-- rights reserved under the copyright laws of the
                                    ' * United States.  Contractor/manufacturer is Silicon Graphics,
                                    ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                                    ' *
                                    ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                                    ' */
                                    
                                    '/*  texturesurf.c
                                    ' *  This program uses evaluators to generate a curved
                                    ' *  surface and automatically generated texture coordinates.
                                    ' */
                                    
                                    #COMPILE EXE
                                    #DIM ALL
                                    
                                    ' // Include files
                                    #INCLUDE ONCE "glu.inc"
                                    
                                    $WindowCaption = "DDT OpenGL: texture surf"
                                    %imageWidth  = 64
                                    %imageHeight = 64
                                    
                                    GLOBAL pGL AS IDDTOpenGL
                                    
                                    ' =======================================================================================
                                    ' OpenGL class
                                    ' =======================================================================================
                                    CLASS CDDTOpenGL
                                    
                                       INSTANCE m_hdc AS DWORD    ' // Device context
                                       INSTANCE m_hrc AS DWORD    ' // Rendering context
                                       INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                                    
                                       INSTANCE ctrlpoints() AS SINGLE
                                       INSTANCE texpts() AS SINGLE
                                       INSTANCE rgimage() AS BYTE
                                    
                                       CLASS METHOD Destroy
                                          ' // Release the device and rendering contexts
                                          IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                          ' // Delete the rendering context
                                          IF m_hrc THEN wglDeleteContext m_hrc
                                          ' // Release the device context
                                          IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                       END METHOD
                                    
                                       ' =====================================================================================
                                       INTERFACE IDDTOpenGL : INHERIT IUnknown
                                       ' =====================================================================================
                                    
                                       ' =====================================================================================
                                       ' Initializes OpenGL
                                       ' =====================================================================================
                                       METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                                    
                                          IF hDlg = 0 THEN EXIT METHOD
                                          m_hDlg = hDlg
                                    
                                          ' // Get the device context
                                          m_hdc = GetDC(m_hDlg)
                                          IF m_hdc = 0 THEN EXIT METHOD
                                    
                                          ' // Bits per pixel
                                          LOCAL nBitsPerPel AS LONG
                                          nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                                    
                                          ' // Depth bits
                                          LOCAL cDepthBits AS LONG
                                          cDepthBits = nBitsPerPel - 8
                                          IF cDepthBits < 16 THEN cDepthBits = 16
                                    
                                          ' // Pixel format
                                          LOCAL 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
                                          LOCAL pf AS LONG
                                          pf = ChoosePixelFormat(m_hdc, pfd)
                                          IF ISFALSE pf THEN
                                             MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                             EXIT METHOD
                                          END IF
                                    
                                          ' // Set the pixel format
                                          IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                             MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                             EXIT METHOD
                                          END IF
                                    
                                          ' // Create a new OpenGL rendering context
                                          m_hrc = wglCreateContext(m_hdc)
                                          IF m_hrc = 0 THEN
                                             MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                             SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                             EXIT METHOD
                                          END IF
                                    
                                          ' // Make it current
                                          IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                             MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                             SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                             EXIT METHOD
                                          END IF
                                    
                                          ' // Return success
                                          METHOD = %TRUE
                                    
                                       END METHOD
                                       ' =====================================================================================
                                    
                                       ' =====================================================================================
                                       METHOD makeImage()
                                    
                                          LOCAL i, j AS LONG
                                          LOCAL ti, tj AS SINGLE
                                    
                                          REDIM rgimage(3 * %imageWidth * %imageHeight) AS INSTANCE BYTE
                                    
                                          FOR i = 0 TO %imageWidth - 1
                                             ti = 2.0 * 3.14159265 * i / %imageWidth
                                             FOR j = 0 TO %imageHeight - 1
                                                tj = 2.0 * 3.14159265 * j / %imageHeight
                                                rgimage(3*(%imageHeight*i+j)) = 127*(1.0 + SIN(ti))
                                                rgimage(3*(%imageHeight*i+j)+1) = 127*(1.0 + COS(2*tj))
                                                rgimage(3*(%imageHeight*i+j)+2) = 127*(1.0 + COS(ti+tj))
                                             NEXT
                                          NEXT
                                    
                                       END METHOD
                                       ' =====================================================================================
                                    
                                       ' =====================================================================================
                                       ' All the setup goes here
                                       ' =====================================================================================
                                       METHOD SetupScene
                                    
                                          REDIM ctrlpoints(2, 3, 3) AS INSTANCE SINGLE
                                    
                                          ctrlpoints(0, 0, 0) = -1.5 : ctrlpoints(1, 0, 0) = -1.5 : ctrlpoints(2, 0, 0) =  4.0
                                          ctrlpoints(0, 1, 0) = -0.5 : ctrlpoints(1, 1, 0) = -1.5 : ctrlpoints(2, 1, 0) =  2.0
                                          ctrlpoints(0, 2, 0) =  0.5 : ctrlpoints(1, 2, 0) = -1.5 : ctrlpoints(2, 2, 0) = -1.0
                                          ctrlpoints(0, 3, 0) =  1.5 : ctrlpoints(1, 3, 0) = -1.5 : ctrlpoints(2, 3, 0) =  2.0
                                    
                                          ctrlpoints(0, 0, 1) = -1.5 : ctrlpoints(1, 0, 1) = -0.5 : ctrlpoints(2, 0, 1) =  1.0
                                          ctrlpoints(0, 1, 1) = -0.5 : ctrlpoints(1, 1, 1) = -0.5 : ctrlpoints(2, 1, 1) =  3.0
                                          ctrlpoints(0, 2, 1) =  0.5 : ctrlpoints(1, 2, 1) = -0.5 : ctrlpoints(2, 2, 1) =  0.0
                                          ctrlpoints(0, 3, 1) =  1.5 : ctrlpoints(1, 3, 1) = -0.5 : ctrlpoints(2, 3, 1) = -1.0
                                    
                                          ctrlpoints(0, 0, 2) = -1.5 : ctrlpoints(1, 0, 2) = -0.5 : ctrlpoints(2, 0, 2) =  4.0
                                          ctrlpoints(0, 1, 2) = -0.5 : ctrlpoints(1, 1, 2) = -0.5 : ctrlpoints(2, 1, 2) =  0.0
                                          ctrlpoints(0, 2, 2) =  0.5 : ctrlpoints(1, 2, 2) = -0.5 : ctrlpoints(2, 2, 2) =  3.0
                                          ctrlpoints(0, 3, 2) =  1.5 : ctrlpoints(1, 3, 2) = -0.5 : ctrlpoints(2, 3, 2) =  4.0
                                    
                                          ctrlpoints(0, 0, 3) = -1.5 : ctrlpoints(1, 0, 3) = 1.5 : ctrlpoints(2, 0, 3) = -2.0
                                          ctrlpoints(0, 1, 3) = -0.5 : ctrlpoints(1, 1, 3) = 1.5 : ctrlpoints(2, 1, 3) = -2.0
                                          ctrlpoints(0, 2, 3) =  0.5 : ctrlpoints(1, 2, 3) = 1.5 : ctrlpoints(2, 2, 3) =  0.0
                                          ctrlpoints(0, 3, 3) =  1.5 : ctrlpoints(1, 3, 3) = 1.5 : ctrlpoints(2, 3, 3) = -1.0
                                    
                                          REDIM texpts(1, 1, 1) AS INSTANCE SINGLE
                                          texpts(0, 0, 0) = 0.0 : texpts(1, 0, 0) = 0.0
                                          texpts(0, 1, 0) = 0.0 : texpts(1, 1, 0) = 1.0
                                          texpts(0, 0, 1) = 1.0 : texpts(1, 0, 1) = 0.0
                                          texpts(0, 1, 1) = 1.0 : texpts(1, 1, 1) = 1.0
                                    
                                          glMap2f %GL_MAP2_VERTEX_3, 0, 1, 3, 4, _
                                                  0, 1, 12, 4, ctrlpoints(0, 0, 0)
                                          glMap2f %GL_MAP2_TEXTURE_COORD_2, 0, 1, 2, 2, _
                                                  0, 1, 4, 2, texpts(0, 0, 0)
                                          glEnable %GL_MAP2_TEXTURE_COORD_2
                                          glEnable %GL_MAP2_VERTEX_3
                                          glMapGrid2f 20, 0.0, 1.0, 20, 0.0, 1.0
                                          ME.makeImage
                                          glTexEnvf %GL_TEXTURE_ENV, %GL_TEXTURE_ENV_MODE, %GL_DECAL
                                          glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_WRAP_S, %GL_REPEAT
                                          glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_WRAP_T, %GL_REPEAT
                                          glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_NEAREST
                                          glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_NEAREST
                                          glTexImage2D %GL_TEXTURE_2D, 0, %GL_RGB, %imageWidth, %imageHeight, 0, _
                                                       %GL_RGB, %GL_UNSIGNED_BYTE, rgimage(0)
                                          glEnable %GL_TEXTURE_2D
                                          glEnable %GL_DEPTH_TEST
                                          glShadeModel %GL_FLAT
                                    
                                       END METHOD
                                       ' =====================================================================================
                                    
                                       ' =====================================================================================
                                       ' Resize the scene
                                       ' =====================================================================================
                                       METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                                    
                                          glViewport 0, 0, w, h
                                          glMatrixMode %GL_PROJECTION
                                          glLoadIdentity
                                          IF w <= h THEN
                                             glOrtho -4.0, 4.0, -4.0*h/w, 4.0*h/w, -4.0, 4.0
                                          ELSE
                                             glOrtho -4.0*w/h, 4.0*w/h, -4.0, 4.0, -4.0, 4.0
                                          END IF
                                          glMatrixMode %GL_MODELVIEW
                                          glLoadIdentity
                                          glRotatef 85.0, 1.0, 1.0, 1.0
                                    
                                       END METHOD
                                       ' =====================================================================================
                                    
                                       ' =======================================================================================
                                       ' Render the scene
                                       ' =======================================================================================
                                       METHOD RenderScene
                                    
                                          glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                                          glColor3f 1.0, 1.0, 1.0
                                          glEvalMesh2 %GL_FILL, 0, 20, 0, 20
                                          glFlush
                                    
                                          ' // Exchange the front and back buffers
                                          SwapBuffers m_hdc
                                    
                                       END METHOD
                                       ' =======================================================================================
                                    
                                       ' ====================================================================================
                                       ' Processes keystrokes
                                       ' ====================================================================================
                                       METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                          SELECT CASE wMsg
                                             CASE %WM_KEYDOWN
                                                SELECT CASE LO(WORD, wParam)
                                                   CASE %VK_ESCAPE
                                                      ' // Send a message to close the application
                                                      DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                                END SELECT
                                          END SELECT
                                       END METHOD
                                       ' ====================================================================================
                                    
                                       END INTERFACE
                                    
                                    END CLASS
                                    ' =======================================================================================
                                    
                                    ' ========================================================================================
                                    ' Main
                                    ' ========================================================================================
                                    FUNCTION PBMAIN () AS LONG
                                    
                                       ' // Create the dialog
                                       LOCAL hDlg AS DWORD
                                       DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                                    
                                       ' // Create an instance of the DX9 class
                                       pGL = CLASS "CDDTOpenGL"
                                       IF ISNOTHING(pGL) THEN EXIT FUNCTION
                                    
                                       ' // Initialize OpenGL
                                       IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                                    
                                       ' // Display and activate the dialog
                                       DIALOG SHOW MODELESS hDlg, CALL DlgProc
                                    
                                       ' // Set the timer
                                       SetTimer(hDlg, 1, 0, %NULL)
                                    
                                       ' // Message loop
                                       LOCAL uMsg AS tagMsg
                                       WHILE GetMessage(uMsg, %NULL, 0, 0)
                                          TranslateMessage uMsg
                                          DispatchMessage uMsg
                                       WEND
                                    
                                       ' // Kill the timer
                                       KillTimer(hDlg, 1)
                                    
                                    END FUNCTION
                                    ' ========================================================================================
                                    
                                    ' ========================================================================================
                                    ' Main Dialog procedure
                                    ' ========================================================================================
                                    CALLBACK FUNCTION DlgProc() AS LONG
                                    
                                       SELECT CASE CB.MSG
                                    
                                          CASE %WM_SYSCOMMAND
                                             ' // Disable the Windows screensaver
                                             IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                             ' // Close the window
                                             IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                                    
                                          CASE %WM_INITDIALOG
                                             ' // Set up the scene
                                             pGL.SetupScene
                                    
                                          CASE %WM_TIMER
                                             ' // Render the scene
                                             pGL.RenderScene
                                    
                                          CASE %WM_SIZE
                                             ' // Resize the scene
                                             pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                                    
                                          CASE %WM_KEYDOWN
                                             ' // Process keystrokes
                                             pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                                    
                                          CASE %WM_CLOSE
                                             ' // Post a message to end the application
                                             DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                                    
                                          CASE %WM_DESTROY
                                             ' // End the application
                                             ' // Use this method instead of DIALOG END with modeless dialogs
                                             PostQuitMessage 0
                                    
                                       END SELECT
                                    
                                    END FUNCTION
                                    ' ========================================================================================
                                    Attached Files
                                    Forum: http://www.jose.it-berater.org/smfforum/index.php

                                    Comment


                                    • #58
                                      OpenGL: torus

                                      This program demonstrates the creation of a display list.

                                      Code:
                                      ' ########################################################################################
                                      ' Microsoft Windows
                                      ' File: EX_DDT_OpenGL_torus.bas
                                      ' Compilers: PBWIN 10+, PBCC 6+
                                      ' Headers: Windows API headers 3.0+
                                      ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                                      ' ########################################################################################
                                      
                                      '/*
                                      ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                                      ' * ALL RIGHTS RESERVED
                                      ' * Permission to use, copy, modify, and distribute this software for
                                      ' * any purpose and without fee is hereby granted, provided that the above
                                      ' * copyright notice appear in all copies and that both the copyright notice
                                      ' * and this permission notice appear in supporting documentation, and that
                                      ' * the name of Silicon Graphics, Inc. not be used in advertising
                                      ' * or publicity pertaining to distribution of the software without specific,
                                      ' * written prior permission.
                                      ' *
                                      ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                                      ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                                      ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                                      ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                                      ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                                      ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                                      ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                                      ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                                      ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                                      ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                                      ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                                      ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                                      ' *
                                      ' * US Government Users Restricted Rights
                                      ' * Use, duplication, or disclosure by the Government is subject to
                                      ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                                      ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                                      ' * clause at DFARS 252.227-7013 and/or in similar or successor
                                      ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                                      ' * Unpublished-- rights reserved under the copyright laws of the
                                      ' * United States.  Contractor/manufacturer is Silicon Graphics,
                                      ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                                      ' *
                                      ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                                      ' */
                                      
                                      '/*
                                      ' *  torus.c
                                      ' *  This program demonstrates the creation of a display list.
                                      ' */
                                      
                                      #COMPILE EXE
                                      #DIM ALL
                                      
                                      ' // Include files
                                      #INCLUDE ONCE "glu.inc"
                                      
                                      $WindowCaption = "DDT OpenGL: torus"
                                      MACRO PI_ = 3.14159265358979323846
                                      
                                      GLOBAL pGL AS IDDTOpenGL
                                      
                                      ' =======================================================================================
                                      ' OpenGL class
                                      ' =======================================================================================
                                      CLASS CDDTOpenGL
                                      
                                         INSTANCE m_hdc AS DWORD    ' // Device context
                                         INSTANCE m_hrc AS DWORD    ' // Rendering context
                                         INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                                      
                                         INSTANCE theTorus AS DWORD
                                      
                                         CLASS METHOD Destroy
                                            ' // Release the device and rendering contexts
                                            IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                            ' // Delete the rendering context
                                            IF m_hrc THEN wglDeleteContext m_hrc
                                            ' // Release the device context
                                            IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                         END METHOD
                                      
                                         ' =====================================================================================
                                         INTERFACE IDDTOpenGL : INHERIT IUnknown
                                         ' =====================================================================================
                                      
                                         ' =====================================================================================
                                         ' Initializes OpenGL
                                         ' =====================================================================================
                                         METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                                      
                                            IF hDlg = 0 THEN EXIT METHOD
                                            m_hDlg = hDlg
                                      
                                            ' // Get the device context
                                            m_hdc = GetDC(m_hDlg)
                                            IF m_hdc = 0 THEN EXIT METHOD
                                      
                                            ' // Bits per pixel
                                            LOCAL nBitsPerPel AS LONG
                                            nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                                      
                                            ' // Depth bits
                                            LOCAL cDepthBits AS LONG
                                            cDepthBits = nBitsPerPel - 8
                                            IF cDepthBits < 16 THEN cDepthBits = 16
                                      
                                            ' // Pixel format
                                            LOCAL 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
                                            LOCAL pf AS LONG
                                            pf = ChoosePixelFormat(m_hdc, pfd)
                                            IF ISFALSE pf THEN
                                               MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                               EXIT METHOD
                                            END IF
                                      
                                            ' // Set the pixel format
                                            IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                               MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                               EXIT METHOD
                                            END IF
                                      
                                            ' // Create a new OpenGL rendering context
                                            m_hrc = wglCreateContext(m_hdc)
                                            IF m_hrc = 0 THEN
                                               MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                               SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                               EXIT METHOD
                                            END IF
                                      
                                            ' // Make it current
                                            IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                               MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                               SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                               EXIT METHOD
                                            END IF
                                      
                                            ' // Return success
                                            METHOD = %TRUE
                                      
                                         END METHOD
                                         ' =====================================================================================
                                      
                                         ' =====================================================================================
                                         ' /* Draw a torus */
                                         ' =====================================================================================
                                         METHOD torus(BYVAL numc AS LONG, BYVAL numt AS LONG)
                                      
                                            LOCAL i, j, k AS LONG
                                            LOCAL s, t, x, y, z, twopi AS DOUBLE
                                      
                                            twopi = 2 * PI_
                                            FOR i = 0 TO numc - 1
                                               glBegin %GL_QUAD_STRIP
                                               FOR j = 0 TO numt
                                                  FOR k = 1 TO 0 STEP -1
                                                     s = (i + k) MOD numc + 0.5
                                                     t = j MOD numt
                                      
                                                     x = (1+.1*COS(s*twopi/numc))*COS(t*twopi/numt)
                                                     y = (1+.1*COS(s*twopi/numc))*SIN(t*twopi/numt)
                                                     z = .1 * SIN(s * twopi / numc)
                                                     glVertex3f x, y, z
                                                  NEXT
                                               NEXT
                                               glEnd
                                            NEXT
                                      
                                         END METHOD
                                         ' =====================================================================================
                                      
                                         ' =====================================================================================
                                         ' All the setup goes here
                                         ' =====================================================================================
                                         METHOD SetupScene
                                      
                                            theTorus = glGenLists(1)
                                            glNewList theTorus, %GL_COMPILE
                                            ME.torus(8, 25)
                                            glEndList
                                      
                                            glShadeModel %GL_FLAT
                                            glClearColor 0.0, 0.0, 0.0, 0.0
                                      
                                         END METHOD
                                         ' =====================================================================================
                                      
                                         ' =====================================================================================
                                         ' Resize the scene
                                         ' =====================================================================================
                                         METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                                      
                                            glViewport 0, 0, w, h
                                            glMatrixMode %GL_PROJECTION
                                            glLoadIdentity
                                            gluPerspective 30, w / h, 1.0, 100.0
                                            glMatrixMode %GL_MODELVIEW
                                            glLoadIdentity
                                            gluLookAt 0, 0, 10, 0, 0, 0, 0, 1, 0
                                      
                                         END METHOD
                                         ' =====================================================================================
                                      
                                         ' =======================================================================================
                                         ' Render the scene
                                         ' /* Clear window and draw torus */
                                         ' =======================================================================================
                                         METHOD RenderScene
                                      
                                            glClear %GL_COLOR_BUFFER_BIT
                                            glColor3f 1.0, 1.0, 1.0
                                            glCallList theTorus
                                            glFlush
                                      
                                            ' // Exchange the front and back buffers
                                            SwapBuffers m_hdc
                                      
                                         END METHOD
                                         ' =======================================================================================
                                      
                                         ' ====================================================================================
                                         ' Processes keystrokes
                                         ' ====================================================================================
                                         METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                            SELECT CASE wMsg
                                               CASE %WM_KEYDOWN
                                                  SELECT CASE LO(WORD, wParam)
                                                     CASE %VK_ESCAPE
                                                        ' // Send a message to close the application
                                                        DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                                     CASE %VK_X
                                                        glRotatef 30.0, 1.0, 0.0, 0.0
                                                     CASE %VK_Y
                                                        glRotatef 30.0, 0.0, 1.0, 0.0
                                                     CASE %VK_I
                                                        glLoadIdentity
                                                        gluLookAt 0, 0, 10, 0, 0, 0, 0, 1, 0
                                                  END SELECT
                                            END SELECT
                                         END METHOD
                                         ' ====================================================================================
                                      
                                         END INTERFACE
                                      
                                      END CLASS
                                      ' =======================================================================================
                                      
                                      ' ========================================================================================
                                      ' Main
                                      ' ========================================================================================
                                      FUNCTION PBMAIN () AS LONG
                                      
                                         ' // Create the dialog
                                         LOCAL hDlg AS DWORD
                                         DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                                      
                                         ' // Create an instance of the DX9 class
                                         pGL = CLASS "CDDTOpenGL"
                                         IF ISNOTHING(pGL) THEN EXIT FUNCTION
                                      
                                         ' // Initialize OpenGL
                                         IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                                      
                                         ' // Display and activate the dialog
                                         DIALOG SHOW MODELESS hDlg, CALL DlgProc
                                      
                                         ' // Set the timer
                                         SetTimer(hDlg, 1, 0, %NULL)
                                      
                                         ' // Message loop
                                         LOCAL uMsg AS tagMsg
                                         WHILE GetMessage(uMsg, %NULL, 0, 0)
                                            TranslateMessage uMsg
                                            DispatchMessage uMsg
                                         WEND
                                      
                                         ' // Kill the timer
                                         KillTimer(hDlg, 1)
                                      
                                      END FUNCTION
                                      ' ========================================================================================
                                      
                                      ' ========================================================================================
                                      ' Main Dialog procedure
                                      ' ========================================================================================
                                      CALLBACK FUNCTION DlgProc() AS LONG
                                      
                                         SELECT CASE CB.MSG
                                      
                                            CASE %WM_SYSCOMMAND
                                               ' // Disable the Windows screensaver
                                               IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                               ' // Close the window
                                               IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                                      
                                            CASE %WM_INITDIALOG
                                               ' // Set up the scene
                                               pGL.SetupScene
                                      
                                            CASE %WM_TIMER
                                               ' // Render the scene
                                               pGL.RenderScene
                                      
                                            CASE %WM_SIZE
                                               ' // Resize the scene
                                               pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                                      
                                            CASE %WM_KEYDOWN
                                               ' // Process keystrokes
                                               pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                                      
                                            CASE %WM_CLOSE
                                               ' // Post a message to end the application
                                               DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                                      
                                            CASE %WM_DESTROY
                                               ' // End the application
                                               ' // Use this method instead of DIALOG END with modeless dialogs
                                               PostQuitMessage 0
                                      
                                         END SELECT
                                      
                                      END FUNCTION
                                      ' ========================================================================================
                                      Attached Files
                                      Forum: http://www.jose.it-berater.org/smfforum/index.php

                                      Comment


                                      • #59
                                        OpenGL: trim

                                        This program draws a NURBS surface in the shape of a symmetrical hill, using both a NURBS curve and pwl (piecewise linear) curve to trim part of the surface.

                                        Code:
                                        ' ########################################################################################
                                        ' Microsoft Windows
                                        ' File: EX_DDT_OpenGL_trim.bas
                                        ' Compilers: PBWIN 10+, PBCC 6+
                                        ' Headers: Windows API headers 3.0+
                                        ' Copyright (c) 2012 José Roca. Freeware. Use at your own risk
                                        ' ########################################################################################
                                        
                                        '/*
                                        ' * Copyright (c) 1993-1997, Silicon Graphics, Inc.
                                        ' * ALL RIGHTS RESERVED
                                        ' * Permission to use, copy, modify, and distribute this software for
                                        ' * any purpose and without fee is hereby granted, provided that the above
                                        ' * copyright notice appear in all copies and that both the copyright notice
                                        ' * and this permission notice appear in supporting documentation, and that
                                        ' * the name of Silicon Graphics, Inc. not be used in advertising
                                        ' * or publicity pertaining to distribution of the software without specific,
                                        ' * written prior permission.
                                        ' *
                                        ' * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
                                        ' * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
                                        ' * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
                                        ' * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
                                        ' * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
                                        ' * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
                                        ' * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
                                        ' * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
                                        ' * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
                                        ' * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
                                        ' * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
                                        ' * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
                                        ' *
                                        ' * US Government Users Restricted Rights
                                        ' * Use, duplication, or disclosure by the Government is subject to
                                        ' * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
                                        ' * (c)(1)(ii) of the Rights in Technical Data and Computer Software
                                        ' * clause at DFARS 252.227-7013 and/or in similar or successor
                                        ' * clauses in the FAR or the DOD or NASA FAR Supplement.
                                        ' * Unpublished-- rights reserved under the copyright laws of the
                                        ' * United States.  Contractor/manufacturer is Silicon Graphics,
                                        ' * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
                                        ' *
                                        ' * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
                                        ' */
                                        
                                        '/*
                                        ' *  trim.c
                                        ' *  This program draws a NURBS surface in the shape of a
                                        ' *  symmetrical hill, using both a NURBS curve and pwl
                                        ' *  (piecewise linear) curve to trim part of the surface.
                                        ' */
                                        
                                        #COMPILE EXE
                                        #DIM ALL
                                        
                                        ' // Include files
                                        #INCLUDE ONCE "glu.inc"
                                        
                                        $WindowCaption = "DDT OpenGL: trim"
                                        
                                        GLOBAL pGL AS IDDTOpenGL
                                        
                                        ' =======================================================================================
                                        ' OpenGL class
                                        ' =======================================================================================
                                        CLASS CDDTOpenGL
                                        
                                           INSTANCE m_hdc AS DWORD    ' // Device context
                                           INSTANCE m_hrc AS DWORD    ' // Rendering context
                                           INSTANCE m_hDlg AS DWORD   ' // Dialog handle
                                        
                                           INSTANCE ctlpoints () AS SINGLE
                                           INSTANCE theNurb AS DWORD
                                        
                                           CLASS METHOD Destroy
                                              ' // Release the device and rendering contexts
                                              IF m_hdc THEN wglMakeCurrent m_hdc, 0
                                              ' // Delete the rendering context
                                              IF m_hrc THEN wglDeleteContext m_hrc
                                              ' // Release the device context
                                              IF m_hdc THEN ReleaseDC m_hDlg, m_hdc
                                           END METHOD
                                        
                                           ' =====================================================================================
                                           INTERFACE IDDTOpenGL : INHERIT IUnknown
                                           ' =====================================================================================
                                        
                                           ' =====================================================================================
                                           ' Initializes OpenGL
                                           ' =====================================================================================
                                           METHOD InitOpenGL (BYVAL hDlg AS DWORD) AS LONG
                                        
                                              IF hDlg = 0 THEN EXIT METHOD
                                              m_hDlg = hDlg
                                        
                                              ' // Get the device context
                                              m_hdc = GetDC(m_hDlg)
                                              IF m_hdc = 0 THEN EXIT METHOD
                                        
                                              ' // Bits per pixel
                                              LOCAL nBitsPerPel AS LONG
                                              nBitsPerPel = GetDeviceCaps(m_hdc, %BITSPIXEL)
                                        
                                              ' // Depth bits
                                              LOCAL cDepthBits AS LONG
                                              cDepthBits = nBitsPerPel - 8
                                              IF cDepthBits < 16 THEN cDepthBits = 16
                                        
                                              ' // Pixel format
                                              LOCAL 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
                                              LOCAL pf AS LONG
                                              pf = ChoosePixelFormat(m_hdc, pfd)
                                              IF ISFALSE pf THEN
                                                 MessageBox(m_hDlg, "Can't find a suitable pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                                 EXIT METHOD
                                              END IF
                                        
                                              ' // Set the pixel format
                                              IF ISFALSE SetPixelFormat(m_hdc, pf, pfd) THEN
                                                 MessageBox(m_hDlg, "Can't set the pixel format", FUNCNAME$, %MB_OK OR %MB_ICONINFORMATION)
                                                 EXIT METHOD
                                              END IF
                                        
                                              ' // Create a new OpenGL rendering context
                                              m_hrc = wglCreateContext(m_hdc)
                                              IF m_hrc = 0 THEN
                                                 MessageBox m_hDlg, "Can't create an OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                                 EXIT METHOD
                                              END IF
                                        
                                              ' // Make it current
                                              IF ISFALSE wglMakeCurrent(m_hdc, m_hrc) THEN
                                                 MessageBox m_hDlg, "Can't activate the OpenGL rendering context", FUNCNAME$, %MB_OK OR %MB_ICONEXCLAMATION
                                                 SendMessage m_hDlg, %WM_CLOSE, 0, 0
                                                 EXIT METHOD
                                              END IF
                                        
                                              ' // Return success
                                              METHOD = %TRUE
                                        
                                           END METHOD
                                           ' =====================================================================================
                                        
                                           ' =====================================================================================
                                           '/*
                                           ' *  Initializes the control points of the surface to a small hill.
                                           ' *  The control points range from -3 to +3 in x, y, and z
                                           ' */
                                           ' =====================================================================================
                                           METHOD init_surface()
                                        
                                              LOCAL u, v AS LONG
                                              DIM ctlpoints(2, 3, 3)
                                        
                                              FOR u = 0 TO 3
                                                 FOR v = 0 TO 3
                                                    ctlpoints(0, v, u) = 2.0 * (u - 1.5)
                                                    ctlpoints(1, v, u) = 2.0 * (v - 1.5)
                                        
                                                    IF (u = 1 OR u = 2) AND (v = 1 OR v = 2) THEN
                                                       ctlpoints(2, v, u) = 3.0
                                                    ELSE
                                                       ctlpoints(2, v, 8)= -3.0
                                                    END IF
                                                 NEXT
                                              NEXT
                                        
                                           END METHOD
                                           ' =====================================================================================
                                        
                                           ' =====================================================================================
                                           ' All the setup goes here
                                           ' Initialize material property and depth buffer.
                                           ' =====================================================================================
                                           METHOD SetupScene
                                        
                                              DIM mat_diffuse(3) AS SINGLE
                                              DIM mat_specular(3) AS SINGLE
                                              DIM mat_shininess(0) AS SINGLE
                                        
                                              ARRAY ASSIGN mat_diffuse() = 0.7, 0.7, 0.7, 1.0
                                              ARRAY ASSIGN mat_specular() = 1.0, 1.0, 1.0, 1.0
                                              ARRAY ASSIGN mat_shininess() = 100.0
                                        
                                              glClearColor 0.0, 0.0, 0.0, 0.0
                                              glMaterialfv %GL_FRONT, %GL_DIFFUSE, mat_diffuse(0)
                                              glMaterialfv %GL_FRONT, %GL_SPECULAR, mat_specular(0)
                                              glMaterialfv %GL_FRONT, %GL_SHININESS, mat_shininess(0)
                                        
                                              glEnable %GL_LIGHTING
                                              glEnable %GL_LIGHT0
                                              glEnable %GL_DEPTH_TEST
                                              glEnable %GL_AUTO_NORMAL
                                              glEnable %GL_NORMALIZE
                                        
                                              ME.init_surface
                                        
                                              theNurb = gluNewNurbsRenderer
                                              gluNurbsProperty theNurb, %GLU_SAMPLING_TOLERANCE, 25.0
                                              gluNurbsProperty theNurb, %GLU_DISPLAY_MODE, %GLU_FILL
                                        
                                           END METHOD
                                           ' =====================================================================================
                                        
                                           ' =====================================================================================
                                           ' Resize the scene
                                           ' =====================================================================================
                                           METHOD ResizeScene (BYVAL w AS LONG, BYVAL h AS LONG)
                                        
                                              glViewport 0, 0, w, h
                                              glMatrixMode %GL_PROJECTION
                                              glLoadIdentity
                                              gluPerspective 45.0, w / h, 3.0, 8.0
                                        
                                              glMatrixMode %GL_MODELVIEW
                                              glLoadIdentity
                                              glTranslatef 0.0, 0.0, -5.0
                                        
                                           END METHOD
                                           ' =====================================================================================
                                        
                                           ' =======================================================================================
                                           ' Render the scene
                                           ' /* Clear window and draw torus */
                                           ' =======================================================================================
                                           METHOD RenderScene
                                        
                                              DIM knots(7) AS SINGLE
                                              ARRAY ASSIGN knots() = 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0
                                        
                                              DIM edgePt(1, 4) AS SINGLE   ' /* counter clockwise */
                                              EdgePt(0, 0) = 0.0 : EdgePt(1, 0) = 0.0
                                              EdgePt(0, 1) = 1.0 : EdgePt(1, 1) = 0.0
                                              EdgePt(0, 2) = 1.0 : EdgePt(1, 2) = 1.0
                                              EdgePt(0, 3) = 0.0 : EdgePt(1, 3) = 1.0
                                              EdgePt(0, 4) = 0.0 : EdgePt(1, 4) = 0.0
                                        
                                              DIM curvePt(1, 3) AS SINGLE   ' /* clockwise */
                                              curvePt(0, 0) = 0.25 : curvePt(1, 0) = 0.5
                                              curvePt(0, 1) = 0.25 : curvePt(1, 1) = 0.75
                                              curvePt(0, 2) = 0.75 : curvePt(1, 2) = 0.75
                                              curvePt(0, 3) = 0.75 : curvePt(1, 3) = 0.5
                                        
                                              DIM curveKnots(7) AS SINGLE
                                              ARRAY ASSIGN curveKnots() = 0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0
                                        
                                              DIM pwlPt(1, 3) AS SINGLE   ' /* clockwise */
                                              pwlPt(0, 0) = 0.75 : pwlPt(1, 0) = 0.5
                                              pwlPt(0, 1) = 0.5  : pwlPt(1, 1) = 0.25
                                              pwlPt(0, 2) = 0.25 : pwlPt(1, 2) = 0.5
                                              pwlPt(0, 3) = 0.25 : pwlPt(1, 3) = 0.5
                                        
                                              glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
                                              glPushMatrix
                                              glRotatef 330.0, 1.0, 0.0, 0.0
                                              glScalef  0.5, 0.5, 0.5
                                        
                                              gluBeginSurface theNurb
                                              gluNurbsSurface theNurb, 8, knots(0), 8, knots(0), _
                                                              4 * 3, 3, ctlpoints(0, 0, 0), _
                                                              4, 4, %GL_MAP2_VERTEX_3
                                              gluBeginTrim theNurb
                                                 gluPwlCurve theNurb, 5, edgePt(0, 0), 2, %GLU_MAP1_TRIM_2
                                              gluEndTrim theNurb
                                              gluBeginTrim theNurb
                                                 gluNurbsCurve theNurb, 8, curveKnots(0), 2, _
                                                               curvePt(0, 0), 4, %GLU_MAP1_TRIM_2
                                                 gluPwlCurve theNurb, 3, pwlPt(0, 0), 2, %GLU_MAP1_TRIM_2
                                              gluEndTrim theNurb
                                              gluEndSurface theNurb
                                        
                                              glPopMatrix
                                              glFlush
                                        
                                              ' // Exchange the front and back buffers
                                              SwapBuffers m_hdc
                                        
                                           END METHOD
                                           ' =======================================================================================
                                        
                                           ' ====================================================================================
                                           ' Processes keystrokes
                                           ' ====================================================================================
                                           METHOD ProcessKeys (BYVAL hDlg AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG)
                                              SELECT CASE wMsg
                                                 CASE %WM_KEYDOWN
                                                    SELECT CASE LO(WORD, wParam)
                                                       CASE %VK_ESCAPE
                                                          ' // Send a message to close the application
                                                          DIALOG SEND hDlg, %WM_CLOSE, 0, 0
                                                       CASE %VK_X
                                                          glRotatef 30.0, 1.0, 0.0, 0.0
                                                       CASE %VK_Y
                                                          glRotatef 30.0, 0.0, 1.0, 0.0
                                                       CASE %VK_I
                                                          glLoadIdentity
                                                          gluLookAt 0, 0, 10, 0, 0, 0, 0, 1, 0
                                                    END SELECT
                                              END SELECT
                                           END METHOD
                                           ' ====================================================================================
                                        
                                           END INTERFACE
                                        
                                        END CLASS
                                        ' =======================================================================================
                                        
                                        ' ========================================================================================
                                        ' Main
                                        ' ========================================================================================
                                        FUNCTION PBMAIN () AS LONG
                                        
                                           ' // Create the dialog
                                           LOCAL hDlg AS DWORD
                                           DIALOG NEW PIXELS, 0, $WindowCaption, , , 600, 400, %WS_OVERLAPPEDWINDOW TO hDlg
                                        
                                           ' // Create an instance of the DX9 class
                                           pGL = CLASS "CDDTOpenGL"
                                           IF ISNOTHING(pGL) THEN EXIT FUNCTION
                                        
                                           ' // Initialize OpenGL
                                           IF ISFALSE pGL.InitOpenGL(hDlg) THEN EXIT FUNCTION
                                        
                                           ' // Display and activate the dialog
                                           DIALOG SHOW MODELESS hDlg, CALL DlgProc
                                        
                                           ' // Set the timer
                                           SetTimer(hDlg, 1, 0, %NULL)
                                        
                                           ' // Message loop
                                           LOCAL uMsg AS tagMsg
                                           WHILE GetMessage(uMsg, %NULL, 0, 0)
                                              TranslateMessage uMsg
                                              DispatchMessage uMsg
                                           WEND
                                        
                                           ' // Kill the timer
                                           KillTimer(hDlg, 1)
                                        
                                        END FUNCTION
                                        ' ========================================================================================
                                        
                                        ' ========================================================================================
                                        ' Main Dialog procedure
                                        ' ========================================================================================
                                        CALLBACK FUNCTION DlgProc() AS LONG
                                        
                                           SELECT CASE CB.MSG
                                        
                                              CASE %WM_SYSCOMMAND
                                                 ' // Disable the Windows screensaver
                                                 IF (CB.WPARAM AND &HFFF0) = %SC_SCREENSAVE THEN FUNCTION = 1
                                                 ' // Close the window
                                                 IF (CB.WPARAM AND &HFFF0) = %SC_CLOSE THEN DIALOG SEND CB.HNDL, %WM_CLOSE, 0, 0
                                        
                                              CASE %WM_INITDIALOG
                                                 ' // Set up the scene
                                                 pGL.SetupScene
                                        
                                              CASE %WM_TIMER
                                                 ' // Render the scene
                                                 pGL.RenderScene
                                        
                                              CASE %WM_SIZE
                                                 ' // Resize the scene
                                                 pGL.ResizeScene LO(WORD, CB.LPARAM), HI(WORD, CB.LPARAM)
                                        
                                              CASE %WM_KEYDOWN
                                                 ' // Process keystrokes
                                                 pGL.ProcessKeys CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM
                                        
                                              CASE %WM_CLOSE
                                                 ' // Post a message to end the application
                                                 DIALOG SEND CB.HNDL, %WM_DESTROY, 0, 0
                                        
                                              CASE %WM_DESTROY
                                                 ' // End the application
                                                 ' // Use this method instead of DIALOG END with modeless dialogs
                                                 PostQuitMessage 0
                                        
                                           END SELECT
                                        
                                        END FUNCTION
                                        ' ========================================================================================
                                        Attached Files
                                        Forum: http://www.jose.it-berater.org/smfforum/index.php

                                        Comment


                                        • #60
                                          Originally posted by José Roca View Post
                                          OpenGL: alpha

                                          This program draws several overlapping filled polygons to demonstrate the effect order has on alpha blending results. Use the 't' key to toggle the order of drawing polygons.
                                          I'd like to know how I can save png 32 bit ARGB color image from OpenGL?

                                          <<< from OpenGL (for example this Post #33 with fully transparent background !)
                                          https://forum.powerbasic.com/forum/j...examples/page2 – Example – OpenGL: alpha – Post #33
                                          >>> to a 32 bit png (maybe GDI+ Flat API) with alpha channel (8 bit transparency)

                                          Desired result for example Post #33:
                                          Saved png image with four zones (32 bit ARGB color) – fully transparent background and three semitransparent zones.


                                          Small working example please!


                                          Comment

                                          Working...
                                          X