Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

DDT OpenGL

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

  • DDT OpenGL

    Code:
    '******************************************************************************
    '
    ' ddtopengl.bas v 1.0
    '
    ' ddt opengl example for pbwin
    '
    ' needs opengl include files (gl.inc and glu.inc) from sublevel6
    '
    ' you can download those files from pb download section or
    ' http://root.tty0.org/sublevel6/ 
    '
    ' tested on win me.
    '
    '
    '                       by rvalois, february 2003.
    '
    '                          www.rvalois.com.br 
    '
    '                          [email protected]
    '
    '
    '     this program is distributed in the hope that it will be useful,
    '     but without any warranty; without even the implied warranty of
    '     merchantability or fitness for a particular purpose.
    '
    '                         use at your own risk
    '
    '******************************************************************************
    '
    #compile exe
    #dim all
    '
    #include "win32api.inc"
    #include "gl.inc"
    #include "glu.inc"
    '
    %idpic = 1000
    '
    global hpic as dword   'handle to the label (picture)
    global hpicdc as dword 'handle to a device context
    global hpicrc as dword 'handle to a rendering context
    '
    '******************************************************************************
    function pixelformatsetup() as long
    '******************************************************************************
      local pfd as pixelformatdescriptor
      local pixelformat as long
    '
      pfd.nsize = sizeof(pixelformatdescriptor)
      pfd.nversion = 1
      pfd.dwflags = %pfd_draw_to_window or %pfd_support_opengl or %pfd_doublebuffer
      pfd.dwlayermask = %pfd_main_plane
      pfd.ipixeltype = %pfd_type_rgba
      pfd.ccolorbits = 24
      pfd.cdepthbits = 24
      pfd.caccumbits = 0
      pfd.cstencilbits = 0
    '
      pixelformat = choosepixelformat(hpicdc , pfd)
      if pixelformat then
        if setpixelformat(hpicdc, pixelformat, pfd) then
          function = %true
          exit function
        end if
      end if
    '
      function = %false
    '
    end function
    '
    '******************************************************************************
    sub sizeopengl(byval dwidth as dword, byval dheight as dword)
    '******************************************************************************
    '
      if dheight = 0 then dheight = 1
    '
      glviewport 0,0,dwidth,dheight
      glmatrixmode %gl_projection
      glloadidentity
      gluperspective 45.0,dwidth/dheight,0.1,150.0
      glmatrixmode %gl_modelview
      glloadidentity
    '
    end sub
    '
    '******************************************************************************
    function initopengl(byval dwidth as dword, byval dheight as dword) as long
    '******************************************************************************
    '
      if pixelformatsetup() then
        hpicrc = wglcreatecontext (hpicdc)
        if hpicrc then
          wglmakecurrent hpicdc, hpicrc
          glenable %gl_depth_test
          sizeopengl dwidth, dheight
          function = %true
          exit function
        end if
      end if
    '
      function = %false
    '
    end function
    '
    '******************************************************************************
    sub drawdiamond()
    '******************************************************************************
    '
    'up
      glbegin %gl_triangle_fan
        glcolor3ub 255?,   0?,   0? : glvertex3f  0!, 1.414!, 0!
        glcolor3ub   0?, 255?,   0? : glvertex3f  1!, 0!, 1!
        glcolor3ub   0?,   0?, 255? : glvertex3f  1!, 0!,-1!
        glcolor3ub   0?, 255?,   0? : glvertex3f -1!, 0!,-1!
        glcolor3ub   0?,   0?, 255? : glvertex3f -1!, 0!, 1!
        glcolor3ub   0?, 255?,   0? : glvertex3f  1!, 0!, 1!
      glend
    '
    'down
      glbegin %gl_triangle_fan
        glcolor3ub 255?,   0?,   0? : glvertex3f  0!,-1.414!, 0!
        glcolor3ub   0?, 255?,   0? : glvertex3f  1!, 0!, 1!
        glcolor3ub   0?,   0?, 255? : glvertex3f -1!, 0!, 1!
        glcolor3ub   0?, 255?,   0? : glvertex3f -1!, 0!,-1!
        glcolor3ub   0?,   0?, 255? : glvertex3f  1!, 0!,-1!
        glcolor3ub   0?, 255?,   0? : glvertex3f  1!, 0!, 1!
      glend
    '
    end sub
    '
    '******************************************************************************
    sub renderopengl
    '******************************************************************************
      static anglex as single
      static angley as single
      static anglez as single
    '
      if hpicrc then
    '
        glclear %gl_color_buffer_bit or %gl_depth_buffer_bit
        glloadidentity
        glulookat 0#, 0#, 5#, 0#, 0#, 0#, 0#, 1#, 0#
    '
        anglex = anglex+0.3!
        angley = angley+0.5!
        anglez = anglez+0.7!
    '
        glrotatef anglex, 1.0!, 0.0!, 0.0!
        glrotatef angley, 0.0!, 1.0!, 0.0!
        glrotatef anglez, 0.0!, 0.0!, 1.0!
    '
        drawdiamond
    '
        swapbuffers hpicdc
    '
      end if
    '
    end sub
    '
    '******************************************************************************
    sub closeopengl
    '******************************************************************************
    '
      wglmakecurrent %null, %null
      if (hpicrc) then
        wgldeletecontext hpicrc
        hpicrc = %false
      end if
    '
    end sub
    '
    '******************************************************************************
    function initdialog(byval hdlg as dword) as long
    '******************************************************************************
      local x as dword
      local y as dword
      local dwidth as dword
      local dheight as dword
    '
      control handle hdlg, %idpic to hpic
      hpicdc = getdc(hpic)
      control get client hdlg, %idpic to x, y
      dialog units hdlg, x, y to pixels dwidth, dheight
      if initopengl (dwidth, dheight) then
        function = %true
        exit function
      end if
    '
      function = %false
    '
    end function
    '
    '******************************************************************************
    sub closedialog()
    '******************************************************************************
    '
      closeopengl
      releasedc hpic,hpicdc
    '
    end sub
    '
    '******************************************************************************
    callback function dlgproc()
    '******************************************************************************
    '
      select case cbmsg
    '
        case %wm_initdialog
          if isfalse initdialog (cbhndl) then
            dialog post cbhndl,%wm_user+999,0,0
          end if
    '
        case %wm_user+999
          msgbox "can't init",%mb_iconerror,"ddt opengl sample"
          dialog end cbhndl
    '
        case %wm_close
          closedialog
    '
      end select
    '
    end function
    '
    '******************************************************************************
    function pbmain() as long
    '******************************************************************************
      local count as long
      local hdlg as dword
      local t as dword
    '
      dialog new %hwnd_desktop, "ddt opengl example",,, 320, 240,%ws_caption or %ws_sysmenu or %ds_center to hdlg
      control add label, hdlg, %idpic,",10,10,300,220, %ws_child or %ws_visible or %ss_sunken
      dialog show modeless hdlg call dlgproc
    '
      do
        dialog doevents to count
        if gettickcount() > t+5??? then
          renderopengl
          t=gettickcount()
        end if
      loop while count
    '
    end function
    '
    '******************************************************************************
    'end
    '******************************************************************************
    http://www.powerbasic.com/support/pb...ead.php?t=7710
    ------------------


    [this message has been edited by roberto valois (edited february 28, 2003).]
    http://www.rvalois.com.br/downloads/free/
Working...
X