Bare Code - Label Control

Category: Graphics - OpenGL

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
#Include "win32api.inc"
#Include "gl.inc"
#Include "glu.inc"
#Include "afxglut.inc"
 
%IDC_Label = 500
Global hDlg, hDC, hRC, hLabel, SpinInWork As Dword, ptLast As Point, ScaleFactor as Single
 
Function PBMain() As Long
   Dialog New Pixels, 0, "OpenGL Example",,, 320, 240, %WS_OverlappedWindow To hDlg
   Control Add Label, hDlg, %IDC_Label,"",0,0,320,240
   Control Handle hDlg, %IDC_Label To hLabel
   Dialog Show Modal hdlg Call dlgproc
End Function
 
CallBack Function dlgproc()
   Local pt As Point, XDelta, YDelta,w,h As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         GetRenderContext
         InitializeScene
         ScaleFactor = 1
         Dialog Post hDlg, %WM_User+500, 0, 0
 
      Case %WM_User+500 : ResizeDialog
      Case %WM_Size     : ResizeDialog
 
      Case %WM_Close
         wglmakecurrent %null, %null 'unselect rendering context
         wgldeletecontext hRC        'delete the rendering context
      Case %WM_MouseWheel
         Select Case Hi(Integer,Cb.WParam)    'note the use of Integer
           Case > 0
              ScaleFactor *= 1.1
              DrawScene 0,0
           Case < 0
              ScaleFactor *= 0.9
              DrawScene 0,0
         End Select
      Case %WM_LButtonDown
         GetCursorPos pt              'pt has xy screen coordinates
         ScreenToClient hDlg, pt      'pt now has dialog client coordinates
         If ChildWindowFromPoint(hDlg,pt) = hLabel Then
            SetCapture hDlg
            SpinInWork = 1
         End If
      Case %WM_MouseMove
         If SpinInWork Then
            GetCursorPos pt           'pt has xy screen coordinates
            ScreenToClient hDC, pt    'pt now has dialog client coordinates
            XDelta = ptLast.x - pt.x
            YDelta = ptLast.y - pt.y
            DrawScene -YDelta, -XDelta
            ptLast.x = pt.x
            ptLast.y = pt.y
         End If
      Case %WM_LButtonUp
         SpinInWork = 0
         ReleaseCapture
   End Select
End Function
 
Sub ResizeDialog
   Local w,h As Long
   Dialog Get Client hDlg To w,h
   Control Set Size hDlg, %IDC_Label, w,h
   ResizeScene w,h
   DrawScene 0,0
End Sub
 
Sub GetRenderContext
   Local pfd As PIXELFORMATDESCRIPTOR, fmt 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
 
   hDC = GetDC(hLabel)                'DC for dialog
   fmt = ChoosePixelFormat(hDC, pfd) 'set device context properties
   SetPixelFormat(hDC, fmt, pfd)    'set properties of device context
   hRC = wglCreateContext (hDC)     'get rendering context
   wglMakeCurrent hDC, hRC          'make the RC current
End Sub
 
Sub InitializeScene
   glClearColor 0,0,0,0     'color to be used with glClear
   glClearDepth 1           'zvalue to be used with glClear
   glDepthFunc %gl_less     'values used for depth-buffer comparisons
   glEnable %gl_depth_test  'enable depth testing
   glShadeModel %gl_smooth  'smooth shading
End Sub
 
Sub ResizeScene (w As Long, h As Long)
   glViewport 0, 0, w, h             'resize viewport
   glMatrixMode %gl_projection       'select projection matrix
   glLoadIdentity                    'reset projection matrix
   gluPerspective 45, w/h, 0.1, 100  'set perspective aspect ratio
   glMatrixMode %gl_modelview        'select modelview matrix
End Sub
 
Sub DrawScene(ddx As Single, ddy As Single)
   Local i,j As Long
   Static angleX, angleY As Long
   glClear %gl_color_buffer_bit Or %gl_depth_buffer_bit
   glLoadIdentity
 
   gluLookAt 0,0,6,0,0,0,0,1,0
   glScalef scalefactor, scalefactor, scalefactor
   anglex = anglex + ddx : glRotatef anglex, 1,0,0
   angley = angley + ddy : glRotatef angley, 0,1,0
 
   afxglutSolidCube 1
 
   SwapBuffers hDC              'display the buffer (image)
End Sub
 
 
'gbs_01298
'Date: 05-11-2013   


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm