Announcement

Collapse
No announcement yet.

Tried to Xprint OpenGL graphics but got blank printout?

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

  • Anne Wilson
    replied
    If we comment out the following codes associated with rendercylinder, there is less flickering
    when we rotate the object

    Code:
       ' Using Cylinders to connect these points
        ' Thanks to George
      '  glPolygonMode( %GL_FRONT_AND_BACK, %GL_LINE )
      '  renderCylinder( 0, 1, 0, -1,0,-4, 0.071,8)
      '  renderCylinder( 0, 1, 0, 1,-1,-4, 0.071,8)
      '  renderCylinder( -1, 0, -4, 1,-1,-4, 0.071,8)
    I believe that this is the best way forward ? What do you think?

    Leave a comment:


  • Anne Wilson
    replied
    Did some amendments which change its points and lines sizes upon zoom in and out.

    Using line primitive instead of triangle -- good for depiction of molecular diagrams?

    And change the vertex coordinates for vertex 1 from 0, 1,-4 to 0, 1, 0
    to ensure that NOT all vertices lies on the same plane of z = -4
    This helps in visualizing the rotation of the object.

    No automatic rotation but control rotation by user using the Left mouse button.

    But flickering still exist but under control

    Code:
    'OpenGL XPrint 3D Rot.bas
    
    
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/774377-tried-to-xprint-opengl-graphics-but-got-blank-printout?p=774418#post774418
     ' Thanks to Gary ,Dale, George
    
        ' Amended to allow for rotations
    
       ' Program to XPRINT the 3D OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Timer   = 1001
      %ID_Label   = 1002
      %ID_Label2  = 1003
      %ID_Label3  = 1004
    
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC , hLabel AS DWORD
     GLOBAL quadric AS DWORD
     GLOBAL OrigScaleFactor, ScaleFactor , scroll_SF AS DOUBLE
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
         LOCAL  hFONT_b2  AS DWORD
       ' Bold font for the labels
        FONT END hFONT_b2
        FONT NEW "Arial",9,1 TO hFONT_b2
    
       DIALOG NEW PIXELS, 0, "3D Model Print with Rotation",,, 580,300,  %WS_BORDER    OR _
                %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the 3D Model " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
      ' Label to hold the OpenGL canvas
        CONTROL ADD LABEL, hdlg, %ID_Label,"",20,50,310,240, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY
    
    
    
       CONTROL ADD LABEL, hDlg, %ID_Label2," Drag and hold the left mouse button to rotate the model",_
               230,5,200,60, %WS_CHILD OR %WS_VISIBLE
          CONTROL SET FONT hDlg, %ID_Label2 , hFONT_b2
          CONTROL SET COLOR hDlg, %ID_Label2 , %RGB_MEDIUMBLUE , -2
    
    
      CONTROL ADD LABEL, hDlg, %ID_Label3," Scroll button to Zoom in and out",_
               450,5,100,60, %WS_CHILD OR %WS_VISIBLE
          CONTROL SET FONT hDlg, %ID_Label3 , hFONT_b2
          CONTROL SET COLOR hDlg, %ID_Label3 , %RGB_MEDIUMBLUE , -2
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
    
         'Clean up of font -- to prevent GDI resource leakage
        FONT END hFONT_b2
    
    
     END FUNCTION
    
    
    
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL wdialog,htdialog AS LONG
        LOCAL XDelta, YDelta AS DOUBLE
        STATIC MouseinWork,XLast,YLast AS LONG
        LOCAL pt AS POINT
    
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
              ' Set a 1 milisec timer so as to show the initial perspective view
              ' using Case %WM_TIMER
              ' After which we stop the timer
                SetTimer(hDlg, %ID_Timer, 1, %NULL)
              ' using a scale factor -- to make object small
             '  use a very small factor
                OrigScaleFactor = 2 '0.5
                ScaleFactor = 2 '0.5
             '  for zoom in and out with the scroll button
                scroll_SF = 1/6
    
    
            CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
                KillTimer CB.HNDL, %ID_Timer
                DrawScene 0,0,0
    
    
           CASE %WM_SIZE
              ' Obtain the size of the existing dialog
               DIALOG GET CLIENT hDlg TO wdialog,htdialog
             ' Change the label or canvas size accordingly
               CONTROL SET SIZE hDlg, %ID_Label,wdialog-50,htdialog-70
               ResizeScene wdialog-50,htdialog-70
               DrawScene  0,0,0
    
    
           CASE %WM_PAINT
                DrawScene 0,0,0
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
    
           CASE %WM_MOUSEWHEEL
              ' Scroll button to zoom in and out
             SELECT CASE HI(INTEGER,CB.WPARAM)
                CASE > 0
                    ' zoom in
                     ScaleFactor = ScaleFactor + scroll_SF*ScaleFactor
                      DrawScene 0,0,0
    
                CASE < 0
                    ' zoom out
                     ScaleFactor = ScaleFactor - scroll_SF*ScaleFactor
                     DrawScene 0,0,0
             END SELECT
    
    
    
    
    
           CASE %WM_CLOSE
               KillTimer hDlg, %ID_Timer
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
    
    
           CASE %WM_SetCursor
              'p.x and p.y are in screen coordinates
             GetCursorPos pt
              'p.x and p.y are now dialog client coordinates
             ScreenToClient hDlg, pt
             IF GetDlgCtrlID(ChildWindowFromPoint( hDlg, pt )) <> %ID_Label THEN
                  EXIT FUNCTION
             END IF
             SELECT CASE HI(WORD, CB.LPARAM)
    
                CASE %WM_LBUTTONDOWN
                   'pt has xy screen coordinates
                   GetCursorPos pt
                   'pt now has dialog client coordinates
                   ScreenToClient hDlg, pt
                   IF pt.y < 0 THEN
                        EXIT SELECT
                   END IF
                   MouseinWork = 1
                   XLast = Pt.x
                   YLast = Pt.y
    
    
                CASE %WM_MOUSEMOVE
                   IF MouseinWork THEN
                        'pt has xy screen coordinates
                      GetCursorPos pt
                      'pt now has dialog client coordinates
                      ScreenToClient hDlg, pt
                      IF pt.y < 0 THEN
                           EXIT SELECT
                      END IF
                      XDelta = XLast - Pt.x
                      YDelta = YLast - Pt.y
                      DrawScene -YDelta, -XDelta, 0
                      XLast = pt.x
                      YLast = pt.y
                   END IF
    
                CASE %WM_LBUTTONUP
                   MouseinWork = 0
    
             END SELECT
    
    
    
    
        END SELECT
     END FUNCTION
    
    
    
    
     '=================================
    ' Prints out the 3D Model to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
     ' See how the bitmap gets printed out from
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/17364-printing-a-bmp-in-pbcc-40?p=229587#post229587
     ' and
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/54775-printing-a-bmp-file-with-xprint
    
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
    
      ' obtain the size of the temp bitmap file
      ' note that 19 and 23 are the offsets to get
      ' size of the bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       ' between upper left point xpr,ypr   and the
       ' lower right point at  xpr+wNew-1,ypr+hNew-10
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
       ' print the encompassing box with a thick width of 8
       XPRINT WIDTH 8
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "3D Model  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    
      ' Close the memory bitmap -- this is a must
      ' to prevent GDI errors
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
        SLEEP 20
       ' Remove the temp bitmap file
        KILL bmpFil
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw   AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw   AS DWORD
      LOCAL fbn   AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
       'hDC must come from the canvas or label and not from the dialog
        CONTROL HANDLE hdlg, %ID_Label TO hLabel
        hDC = GetDC(hLabel)
    
        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 245,255,250,1
         glClearDepth 1         'zvalue to be used with glClear
         quadric = gluNewQuadric                            ' Create a pointer to the quadric object
         gluQuadricNormals quadric, %GLU_SMOOTH             ' Create smooth normals
         gluQuadricTexture quadric, %GL_TRUE                ' Create texture coords
     END SUB
    
    
    '=================================
     SUB ResizeScene (widSc AS LONG, htSc AS LONG)
        glViewport 0, 0, widSc, htSc             'resize viewport
        glMatrixMode %gl_projection       'select projection matrix
        glLoadIdentity                    'reset projection matrix
        gluPerspective 45, widSc/htSc, 0.1, 100  'set perspective aspect ratio
        glMatrixMode %gl_modelview        'select modelview matrix
     END SUB
    
    
    
    '=========================
     SUB DrawScene(dx AS DOUBLE, dy AS DOUBLE, dz AS DOUBLE)
       STATIC anglex, angley, anglez AS DOUBLE
    
       glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit  'clear buffers
       glLoadIdentity               'clear the modelview matrix
       gluLookAt 0,0,10,0,0,0,0,1,0
    
       glScalef scalefactor, scalefactor, scalefactor
    
     ' for user to use mouse to rotate the object
       anglex = anglex + dx : glRotatef anglex, 1,0,0
       angley = angley + dy : glRotatef angley, 0,1,0
       anglez = anglez + dz : glRotatef anglez, 0,0,1
    
    
             ' Line width sizes changes according to zooming
               IF ScaleFactor > 0.6*OrigScaleFactor THEN
                   glLineWidth 5
                ELSE
                  ' use a smaller size
                   glLineWidth 2
                END IF
    
             glcolor3ub 255,0,0    'set default vertex color
    
    
    
         ' Note that vertex1  0, 1, 0 was modified from 0, 1,-4
         ' so that not all the points are at the same plane at z=-4
         ' this helps to show rotation
         ' Using lines
        glBegin %gl_lines
    
           glvertex3f   0, 1, 0    'vertex1
           glvertex3f  -1, 0, -4   'vertex2
    
           glvertex3f  -1, 0, -4    'vertex2
           glvertex3f  1, -1, -4     'vertex3
    
           glvertex3f  1, -1, -4    'vertex3
           glvertex3f  0, 1, 0      'vertex1
    
        glEnd
    
        ' Using Cylinders to connect these points
        ' Thanks to George
        glPolygonMode( %GL_FRONT_AND_BACK, %GL_LINE )
        renderCylinder( 0, 1, 0, -1,0,-4, 0.071,8)
        renderCylinder( 0, 1, 0, 1,-1,-4, 0.071,8)
        renderCylinder( -1, 0, -4, 1,-1,-4, 0.071,8)
    
    
    
          '   Draw the points as spheres
         '    make the spherical points rounder and smoother
           '  and sizes the spheres
    
              '  Point sizes changes according to zooming
                 IF ScaleFactor > 0.6*OrigScaleFactor THEN
                   glPointSize 12.0
                ELSEIF ScaleFactor > 1.1*OrigScaleFactor THEN
                  ' use a larger size
                   glPointSize 25.0
                ELSE
                  ' use a smaller size
                   glPointSize 3.0
                END IF
    
    
    
                 glEnable %GL_POINT_SMOOTH
                 glHint(%GL_POINT_SMOOTH_HINT, %GL_NICEST)
    
               ' color them green
                 glcolor3ub 0,210,105
    
                glBegin %gl_points
                  glvertex3f  0, 1, 0 '-4
                  glvertex3f  -1, 0, -4
                  glvertex3f  1, -1, -4
               glEnd
    
    
        SwapBuffers hDC              'display the buffer (image)
     END SUB
    
    
    '==================================
    ' Need to vary the following to show effects
    ' Radius = distance between lines
    ' subdivisions = no. of division lines
    FUNCTION renderCylinder( x1 AS SINGLE,  y1 AS SINGLE, z1 AS SINGLE, _
         x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, radius AS SINGLE,subdivisions AS LONG) AS LONG
    'https://github.com/curran/renderCyliner
      LOCAL vx, vy, vz, v, ax, rx,ry AS SINGLE
    
      vx = x2-x1
      vy = y2-y1
      vz = z2-z1
      v = SQR( vx*vx + vy*vy + vz*vz )
      'float ax
    
      IF (ABS(vz) < 1.0e-3) THEN
        ax = 57.2957795*ArcCos( vx/v ) '// rotation angle in x-y plane
        IF ( vy <= 0.0 ) THEN ax = -ax
    
      ELSE
        ax = 57.2957795*ArcCos( vz/v )' // rotation angle
        IF ( vz <= 0.0 ) THEN  ax = -ax
      END IF
    
      rx = -vy*vz
      ry = vx*vz
    
      glPushMatrix()
      '//DRAW the cylinder body
      glTranslatef( x1,y1,z1 )
      IF (ABS(vz) < 1.0e-3) THEN
        glRotated(90.0, 0, 1, 0.0)' // Rotate & align with x axis
        glRotated(ax, -1.0, 0.0, 0.0)' // Rotate to point 2 in x-y plane
    
      ELSE
        glRotated(ax, rx, ry, 0.0)' // Rotate about rotation vector
      END IF
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluCylinder(quadric, radius, radius, v, subdivisions, 1)
    
      '//draw the first cap
      gluQuadricOrientation(quadric,%GLU_INSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glTranslatef( 0,0,v )
    
      '//draw the second cap
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glPopMatrix()
    END FUNCTION
    
    
    '==============================
    FUNCTION ArcCos(BYVAL x AS EXTENDED) AS EXTENDED
     LOCAL pi##
     pi## = 3.141592653589793##
     IF     x >= 1 THEN
      FUNCTION = 0
     ELSEIF x <= -1 THEN
      FUNCTION = pi##
     ELSE
      FUNCTION = pi##/2 - ATN(x/SQR(1-x*x))
     END IF
    END FUNCTION
    George, please tell me what do you think about this modeling?





    Leave a comment:


  • George Bandak
    replied
    modifying your code #14 so the graphics rotated around Z axes, there is a small flicker during the rotation..
    i have printed to PDF file successfully while the triangle rotates
    Code:
    'OpenGL XPrint 3D.bas
    
    
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/774377-tried-to-xprint-opengl-graphics-but-got-blank-printout?p=774418#post774418
     ' Thanks to Gary ,Dale, George
    
    
       ' Program to XPRINT the 3D OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Timer   = 1001
      %ID_Label   = 1002
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC , hLabel AS DWORD
     GLOBAL quadric AS DWORD
     GLOBAL rot AS SINGLE
    
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
    
       DIALOG NEW PIXELS, 0, "3D Structure Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the 3D structure " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
      ' Label to hold the OpenGL canvas
        CONTROL ADD LABEL, hdlg, %ID_Label,"",20,50,310,240, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY
    
    
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL wdialog,htdialog AS LONG
    
    
    
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
              ' Set a 1 milisec timer so as to show the initial perspective view
              ' using Case %WM_TIMER
              ' After which we stop the timer
                SetTimer(hDlg, %ID_Timer, 1, %NULL)
    
    
            CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
                'KillTimer CB.HNDL, %ID_Timer
                DrawScene
    
    
           CASE %WM_SIZE
              ' Obtain the size of the existing dialog
               DIALOG GET CLIENT hDlg TO wdialog,htdialog
             ' Change the label or canvas size accordingly
               CONTROL SET SIZE hDlg, %ID_Label,wdialog-50,htdialog-70
               ResizeScene wdialog-50,htdialog-70
               DrawScene
    
    
           CASE %WM_PAINT
                DrawScene
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               KillTimer hDlg, %ID_Timer
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
    
     '=================================
    ' Prints out the 3D structure to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
     ' See how the bitmap gets printed out from
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/17364-printing-a-bmp-in-pbcc-40?p=229587#post229587
     ' and
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/54775-printing-a-bmp-file-with-xprint
    
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
    
      ' obtain the size of the temp bitmap file
      ' note that 19 and 23 are the offsets to get
      ' size of the bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       ' between upper left point xpr,ypr   and the
       ' lower right point at  xpr+wNew-1,ypr+hNew-10
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
       ' print the encompassing box with a thick width of 8
       XPRINT WIDTH 8
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "3D structure  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    
      ' Close the memory bitmap -- this is a must
      ' to prevent GDI errors
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
        SLEEP 20
       ' Remove the temp bitmap file
        KILL bmpFil
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw   AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw   AS DWORD
      LOCAL fbn   AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        CONTROL HANDLE hdlg, %ID_Label TO hLabel
        hDC = GetDC(hLabel)
       ' hDC = GetDC(hDlg)
    
        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 245,255,250,1
         glClearDepth 1         'zvalue to be used with glClear
         quadric = gluNewQuadric                            ' Create a pointer to the quadric object
         gluQuadricNormals quadric, %GLU_SMOOTH             ' Create smooth normals
         gluQuadricTexture quadric, %GL_TRUE                ' Create texture coords
     END SUB
    
    
    '=================================
     SUB ResizeScene (widSc AS LONG, htSc AS LONG)
        glViewport 0, 0, widSc, htSc             'resize viewport
        glMatrixMode %gl_projection       'select projection matrix
        glLoadIdentity                    'reset projection matrix
        gluPerspective 45, widSc/htSc, 0.1, 100  'set perspective aspect ratio
        glMatrixMode %gl_modelview        'select modelview matrix
     END SUB
    
    
    
    '=========================
     SUB DrawScene
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glRotatef(rot, 0,0,1)
        rot=rot+0.5
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
    
        ' Using Cylinders to connect these points
        ' Thanks to George
        glPolygonMode( %GL_FRONT_AND_BACK, %GL_LINE )
        renderCylinder( 0, 1, -4, -1,0,-4, 0.031,5)
        renderCylinder( 0, 1, -4, 1,-1,-4, 0.031,4)
        renderCylinder( -1, 0, -4, 1,-1,-4, 0.031,3)
    
    
          '   Draw the points as spheres
         '    make the spherical points rounder and smoother
           '  and sizes the spheres
    
                 glEnable %GL_POINT_SMOOTH
                 glHint(%GL_POINT_SMOOTH_HINT, %GL_NICEST)
                 glPointSize 18.0
    
               ' color them green
                 glcolor3ub 0,210,105
    
                glBegin %gl_points
                  glvertex3f  0, 1,  -4
                  glvertex3f  -1, 0, -4
                  glvertex3f  1, -1, -4
    
               glEnd
    
    
        SwapBuffers hDC              'display the buffer (image)
     END SUB
    
    
    '==================================
    FUNCTION renderCylinder( x1 AS SINGLE,  y1 AS SINGLE, z1 AS SINGLE, _
         x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, radius AS SINGLE,subdivisions AS LONG) AS LONG',GLUquadricObj *quadric)
    'https://github.com/curran/renderCyliner
      LOCAL vx, vy, vz, v, ax, rx,ry AS SINGLE
      'LOCAL vx, vy, vz, v, ax, x1,x2,y1,y2,z1,z2, rx,ry, radius, subdivisions AS SINGLE
    
      vx = x2-x1
      vy = y2-y1
      vz = z2-z1
      v = SQR( vx*vx + vy*vy + vz*vz )
      'float ax
    
      IF (ABS(vz) < 1.0e-3) THEN
        ax = 57.2957795*ArcCos( vx/v ) '// rotation angle in x-y plane
        IF ( vy <= 0.0 ) THEN ax = -ax
    
      ELSE
        ax = 57.2957795*ArcCos( vz/v )' // rotation angle
        IF ( vz <= 0.0 ) THEN  ax = -ax
      END IF
    
      rx = -vy*vz
      ry = vx*vz
    
      glPushMatrix()
      '//DRAW the cylinder body
      glTranslatef( x1,y1,z1 )
      IF (ABS(vz) < 1.0e-3) THEN
        glRotated(90.0, 0, 1, 0.0)' // Rotate & align with x axis
        glRotated(ax, -1.0, 0.0, 0.0)' // Rotate to point 2 in x-y plane
    
      ELSE
        glRotated(ax, rx, ry, 0.0)' // Rotate about rotation vector
      END IF
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluCylinder(quadric, radius, radius, v, subdivisions, 1)
    
      '//draw the first cap
      gluQuadricOrientation(quadric,%GLU_INSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glTranslatef( 0,0,v )
    
      '//draw the second cap
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glPopMatrix()
    END FUNCTION
    
    
    '==============================
    FUNCTION ArcCos(BYVAL x AS EXTENDED) AS EXTENDED
     LOCAL pi##
     pi## = 3.141592653589793##
     IF     x >= 1 THEN
      FUNCTION = 0
     ELSEIF x <= -1 THEN
      FUNCTION = pi##
     ELSE
      FUNCTION = pi##/2 - ATN(x/SQR(1-x*x))
     END IF
    END FUNCTION

    Leave a comment:


  • Anne Wilson
    replied
    Well George, actually my initial code in post #1 was mainly intended for a 2D drawing (no rotation is required)
    and not a 3D one (which may need to be rotated). This is because cross sections are just 2D drawings.

    Whereas molecular diagrams are in 3D (my assumptions as I'm not in that field of work).
    So can you please modify my post #14's codes to incorporate the 3D rotations as you may required ?

    The timer in post #14 was intended to get the program to display the drawing at the starting time of the dialog
    and after which it is eliminated. That is why
    KillTimer CB.HNDL, %ID_Timer

    Leave a comment:


  • George Bandak
    replied
    Anne, in your above code if we add after:
    SUB DrawScene
    glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
    glLoadIdentity 'clear the modelview matrix


    these lines
    glRotatef(rot, 0,0,1)
    rot=rot+1

    and the rot is dimmed as global single
    the shape will not rotate until we resize the windows from its edges and when we stop resizing it stop to rotate
    i have guessed if we comment KillTimer... in the
    Code:
    CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
               KillTimer CB.HNDL, %ID_Timer
                DrawScene
    it will rotate automatically as usual

    the Gary example here
    http://www.garybeene.com/power/code/..._gbs_00584.htm
    does not contains killing a timer in the Case %WM_Timer event

    Leave a comment:


  • Anne Wilson
    replied
    I have modified it to print 3D

    Code:
    'OpenGL XPrint 3D.bas
    
    
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/774377-tried-to-xprint-opengl-graphics-but-got-blank-printout?p=774418#post774418
     ' Thanks to Gary ,Dale, George
    
    
       ' Program to XPRINT the 3D OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Timer   = 1001
      %ID_Label   = 1002
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC , hLabel AS DWORD
     GLOBAL quadric AS DWORD
    
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
    
       DIALOG NEW PIXELS, 0, "3D Structure Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the 3D structure " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
      ' Label to hold the OpenGL canvas
        CONTROL ADD LABEL, hdlg, %ID_Label,"",20,50,310,240, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY
    
    
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL wdialog,htdialog AS LONG
    
    
    
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
              ' Set a 1 milisec timer so as to show the initial perspective view
              ' using Case %WM_TIMER
              ' After which we stop the timer
                SetTimer(hDlg, %ID_Timer, 1, %NULL)
    
    
            CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
                KillTimer CB.HNDL, %ID_Timer
                DrawScene
    
    
           CASE %WM_SIZE
              ' Obtain the size of the existing dialog
               DIALOG GET CLIENT hDlg TO wdialog,htdialog
             ' Change the label or canvas size accordingly
               CONTROL SET SIZE hDlg, %ID_Label,wdialog-50,htdialog-70
               ResizeScene wdialog-50,htdialog-70
               DrawScene
    
    
           CASE %WM_PAINT
                DrawScene
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               KillTimer hDlg, %ID_Timer
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
    
     '=================================
    ' Prints out the 3D structure to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
     ' See how the bitmap gets printed out from
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/17364-printing-a-bmp-in-pbcc-40?p=229587#post229587
     ' and
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/54775-printing-a-bmp-file-with-xprint
    
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
    
      ' obtain the size of the temp bitmap file
      ' note that 19 and 23 are the offsets to get
      ' size of the bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       ' between upper left point xpr,ypr   and the
       ' lower right point at  xpr+wNew-1,ypr+hNew-10
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
       ' print the encompassing box with a thick width of 8
       XPRINT WIDTH 8
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "3D structure  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    
      ' Close the memory bitmap -- this is a must
      ' to prevent GDI errors
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
        SLEEP 20
       ' Remove the temp bitmap file
        KILL bmpFil
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw   AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw   AS DWORD
      LOCAL fbn   AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        CONTROL HANDLE hdlg, %ID_Label TO hLabel
        hDC = GetDC(hLabel)
       ' hDC = GetDC(hDlg)
    
        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 245,255,250,1
         glClearDepth 1         'zvalue to be used with glClear
         quadric = gluNewQuadric                            ' Create a pointer to the quadric object
         gluQuadricNormals quadric, %GLU_SMOOTH             ' Create smooth normals
         gluQuadricTexture quadric, %GL_TRUE                ' Create texture coords
     END SUB
    
    
    '=================================
     SUB ResizeScene (widSc AS LONG, htSc AS LONG)
        glViewport 0, 0, widSc, htSc             'resize viewport
        glMatrixMode %gl_projection       'select projection matrix
        glLoadIdentity                    'reset projection matrix
        gluPerspective 45, widSc/htSc, 0.1, 100  'set perspective aspect ratio
        glMatrixMode %gl_modelview        'select modelview matrix
     END SUB
    
    
    
    '=========================
     SUB DrawScene
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
    
        ' Using Cylinders to connect these points
        ' Thanks to George
        glPolygonMode( %GL_FRONT_AND_BACK, %GL_LINE )
        renderCylinder( 0, 1, -4, -1,0,-4, 0.031,5)
        renderCylinder( 0, 1, -4, 1,-1,-4, 0.031,4)
        renderCylinder( -1, 0, -4, 1,-1,-4, 0.031,3)
    
    
          '   Draw the points as spheres
         '    make the spherical points rounder and smoother
           '  and sizes the spheres
    
                 glEnable %GL_POINT_SMOOTH
                 glHint(%GL_POINT_SMOOTH_HINT, %GL_NICEST)
                 glPointSize 18.0
    
               ' color them green
                 glcolor3ub 0,210,105
    
                glBegin %gl_points
                  glvertex3f  0, 1,  -4
                  glvertex3f  -1, 0, -4
                  glvertex3f  1, -1, -4
    
               glEnd
    
    
        SwapBuffers hDC              'display the buffer (image)
     END SUB
    
    
    '==================================
    FUNCTION renderCylinder( x1 AS SINGLE,  y1 AS SINGLE, z1 AS SINGLE, _
         x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, radius AS SINGLE,subdivisions AS LONG) AS LONG',GLUquadricObj *quadric)
    'https://github.com/curran/renderCyliner
      LOCAL vx, vy, vz, v, ax, rx,ry AS SINGLE
      'LOCAL vx, vy, vz, v, ax, x1,x2,y1,y2,z1,z2, rx,ry, radius, subdivisions AS SINGLE
    
      vx = x2-x1
      vy = y2-y1
      vz = z2-z1
      v = SQR( vx*vx + vy*vy + vz*vz )
      'float ax
    
      IF (ABS(vz) < 1.0e-3) THEN
        ax = 57.2957795*ArcCos( vx/v ) '// rotation angle in x-y plane
        IF ( vy <= 0.0 ) THEN ax = -ax
    
      ELSE
        ax = 57.2957795*ArcCos( vz/v )' // rotation angle
        IF ( vz <= 0.0 ) THEN  ax = -ax
      END IF
    
      rx = -vy*vz
      ry = vx*vz
    
      glPushMatrix()
      '//DRAW the cylinder body
      glTranslatef( x1,y1,z1 )
      IF (ABS(vz) < 1.0e-3) THEN
        glRotated(90.0, 0, 1, 0.0)' // Rotate & align with x axis
        glRotated(ax, -1.0, 0.0, 0.0)' // Rotate to point 2 in x-y plane
    
      ELSE
        glRotated(ax, rx, ry, 0.0)' // Rotate about rotation vector
      END IF
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluCylinder(quadric, radius, radius, v, subdivisions, 1)
    
      '//draw the first cap
      gluQuadricOrientation(quadric,%GLU_INSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glTranslatef( 0,0,v )
    
      '//draw the second cap
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glPopMatrix()
    END FUNCTION
    
    
    '==============================
    FUNCTION ArcCos(BYVAL x AS EXTENDED) AS EXTENDED
     LOCAL pi##
     pi## = 3.141592653589793##
     IF     x >= 1 THEN
      FUNCTION = 0
     ELSEIF x <= -1 THEN
      FUNCTION = pi##
     ELSE
      FUNCTION = pi##/2 - ATN(x/SQR(1-x*x))
     END IF
    END FUNCTION


    Click image for larger version

Name:	3d struct.png
Views:	142
Size:	2.2 KB
ID:	774424

    Leave a comment:


  • Anne Wilson
    replied
    Thanks so much George

    I'll use these cylinders in another program where 3D views and rotations are required, as this program is intended to draw 2D cross sections shapes
    in structural analysis.

    Please also remove the following comments in the PBMain() as we can now use %WS_THICKFRAME style
    for the dialog without affecting the buttons, we can resize the dialog as we wishes.

    Code:
     
     '  %WS_THICKFRAME is NOT use to ensure that the dialog cannot resize  '  resizing the dialog can make the buttons dissappear

    Leave a comment:


  • George Bandak
    replied
    Congratulations Anne, and thanks for sharing the code. the opengl is usually something intimidating and hard to debug. i visit the opengl subject occasionally from time to time.
    since my printer is corrupted i have used the freeware Bullzip PDF Printer to print to PDF file and the PDF contains your triangle.
    i have found here https://github.com/curran/renderCyliner how to connect any 2 points in opengl scene with a cylinder. so merging that procedure with your example display your triangle vertices connected with cylinders
    the effect is more interesting in 3D rotating examples such as rotating 3D molecules models and so on

    essentials:
    GLOBAL quadric AS DWORD
    'in the initialization:
    quadric = gluNewQuadric ' Create a pointer to the quadric object
    gluQuadricNormals quadric, %GLU_SMOOTH ' Create smooth normals
    gluQuadricTexture quadric, %GL_TRUE ' Create texture coords

    the function usage is like this:
    renderCylinder( x1,y1,z1, x2,y2,z2, cylinder_Radius, cylinder_Subdivisions)

    since the function is using gluCylinder, i can't remember if it needs the glut32.dll or not, if it complains then copy this dll to your system: https://user.xmission.com/~nate/glut.html

    Click image for larger version  Name:	triangle.PNG Views:	1 Size:	6.2 KB ID:	774419

    Code:
    'OpenGL XPrint.bas
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
     ' Thanks to Gary and Dale
    
    
       ' Program to XPRINT the OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Timer   = 1001
      %ID_Label   = 1002
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC , hLabel AS DWORD
     GLOBAL quadric AS DWORD
    
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
     '  %WS_THICKFRAME is NOT use to ensure that the dialog cannot resize
     '  resizing the dialog can make the buttons dissappear
       DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the Cross section " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
      ' Label to hold the OpenGL canvas
        CONTROL ADD LABEL, hdlg, %ID_Label,"",20,50,310,240, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY
    
    
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL wdialog,htdialog AS LONG
    
    
    
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
              ' Set a 1 milisec timer so as to show the initial perspective view
              ' using Case %WM_TIMER
              ' After which we stop the timer
                SetTimer(hDlg, %ID_Timer, 1, %NULL)
    
    
            CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
                KillTimer CB.HNDL, %ID_Timer
                DrawScene
    
    
           CASE %WM_SIZE
              ' Obtain the size of the existing dialog
               DIALOG GET CLIENT hDlg TO wdialog,htdialog
             ' Change the label or canvas size accordingly
               CONTROL SET SIZE hDlg, %ID_Label,wdialog-50,htdialog-70
               ResizeScene wdialog-50,htdialog-70
               DrawScene
    
    
           CASE %WM_PAINT
                DrawScene
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               KillTimer hDlg, %ID_Timer
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
    
     '=================================
    ' Prints out the cross section to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
     ' See how the bitmap gets printed out from
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/17364-printing-a-bmp-in-pbcc-40?p=229587#post229587
     ' and
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/54775-printing-a-bmp-file-with-xprint
    
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
    
      ' obtain the size of the temp bitmap file
      ' note that 19 and 23 are the offsets to get
      ' size of the bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       ' between upper left point xpr,ypr   and the
       ' lower right point at  xpr+wNew-1,ypr+hNew-10
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
       ' print the encompassing box with a thick width of 8
       XPRINT WIDTH 8
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "Cross section  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    
      ' Close the memory bitmap -- this is a must
      ' to prevent GDI errors
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
        SLEEP 20
       ' Remove the temp bitmap file
        KILL bmpFil
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw   AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw   AS DWORD
      LOCAL fbn   AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        CONTROL HANDLE hdlg, %ID_Label TO hLabel
        hDC = GetDC(hLabel)
       ' hDC = GetDC(hDlg)
    
        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 245,255,250,1
         glClearDepth 1         'zvalue to be used with glClear
         quadric = gluNewQuadric                            ' Create a pointer to the quadric object
         gluQuadricNormals quadric, %GLU_SMOOTH             ' Create smooth normals
         gluQuadricTexture quadric, %GL_TRUE                ' Create texture coords
     END SUB
    
    
    '=================================
     SUB ResizeScene (widSc AS LONG, htSc AS LONG)
        glViewport 0, 0, widSc, htSc             'resize viewport
        glMatrixMode %gl_projection       'select projection matrix
        glLoadIdentity                    'reset projection matrix
        gluPerspective 45, widSc/htSc, 0.1, 100  'set perspective aspect ratio
        glMatrixMode %gl_modelview        'select modelview matrix
     END SUB
    
    
    
    '=========================
     SUB DrawScene
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
        glPolygonMode( %GL_FRONT_AND_BACK, %GL_LINE )
        renderCylinder( 0, 1, -4, -1,0,-4, 0.1,8)
        renderCylinder( 0, 1, -4, 1,-1,-4, 0.1,8)
        renderCylinder( -1, 0, -4, 1,-1,-4, 0.1,8)
        SwapBuffers hDC              'display the buffer (image)
     END SUB
    
    FUNCTION renderCylinder( x1 AS SINGLE,  y1 AS SINGLE, z1 AS SINGLE, x2 AS SINGLE, y2 AS SINGLE, z2 AS SINGLE, radius AS SINGLE,subdivisions AS LONG) AS LONG',GLUquadricObj *quadric)
    'https://github.com/curran/renderCyliner
      LOCAL vx, vy, vz, v, ax, rx,ry AS SINGLE
      'LOCAL vx, vy, vz, v, ax, x1,x2,y1,y2,z1,z2, rx,ry, radius, subdivisions AS SINGLE
    
      vx = x2-x1
      vy = y2-y1
      vz = z2-z1
      v = SQR( vx*vx + vy*vy + vz*vz )
      'float ax
    
      IF (ABS(vz) < 1.0e-3) THEN
        ax = 57.2957795*ArcCos( vx/v ) '// rotation angle in x-y plane
        IF ( vy <= 0.0 ) THEN ax = -ax
    
      ELSE
        ax = 57.2957795*ArcCos( vz/v )' // rotation angle
        IF ( vz <= 0.0 ) THEN  ax = -ax
      END IF
    
      rx = -vy*vz
      ry = vx*vz
    
      glPushMatrix()
      '//DRAW the cylinder body
      glTranslatef( x1,y1,z1 )
      IF (ABS(vz) < 1.0e-3) THEN
        glRotated(90.0, 0, 1, 0.0)' // Rotate & align with x axis
        glRotated(ax, -1.0, 0.0, 0.0)' // Rotate to point 2 in x-y plane
    
      ELSE
        glRotated(ax, rx, ry, 0.0)' // Rotate about rotation vector
      END IF
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluCylinder(quadric, radius, radius, v, subdivisions, 1)
    
      '//draw the first cap
      gluQuadricOrientation(quadric,%GLU_INSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glTranslatef( 0,0,v )
    
      '//draw the second cap
      gluQuadricOrientation(quadric,%GLU_OUTSIDE)
      gluDisk( quadric, 0.0, radius, subdivisions, 1)
      glPopMatrix()
    END FUNCTION
    
    FUNCTION ArcCos(BYVAL x AS EXTENDED) AS EXTENDED
     LOCAL pi##
     pi## = 3.141592653589793##
     IF     x >= 1 THEN
      FUNCTION = 0
     ELSEIF x <= -1 THEN
      FUNCTION = pi##
     ELSE
      FUNCTION = pi##/2 - ATN(x/SQR(1-x*x))
     END IF
    END FUNCTION
    .
    Last edited by George Bandak; 19 Aug 2018, 02:24 AM.

    Leave a comment:


  • Dale Yarker
    replied
    You're welcome, but you can leave me out. All I wanted you to do was use the control ID in XPRINT STRETCH and maybe hDlg too. (like help said) But instead you removed CONTROL ADD GRAPHIC and XPRINT STRETCH from the code. i try to encourage looking in Help when the info is there.

    Glad you got it to work.

    Leave a comment:


  • Anne Wilson
    replied
    Finally I got it, very nice and stable OpenGL
    Thanks to Gary and Dale


    Stuart and your g** partner , if you can't help just keep out of my threads, and nobody would say that you are d***


    Here is the code
    Code:
    'OpenGL XPrint.bas
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
     ' Thanks to Gary and Dale
    
    
       ' Program to XPRINT the OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Timer   = 1001
      %ID_Label   = 1002
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC , hLabel AS DWORD
    
    
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
     '  %WS_THICKFRAME is NOT use to ensure that the dialog cannot resize
     '  resizing the dialog can make the buttons dissappear
       DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the Cross section " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
      ' Label to hold the OpenGL canvas
        CONTROL ADD LABEL, hdlg, %ID_Label,"",20,50,310,240, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_SUNKEN OR %SS_NOTIFY
    
    
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL wdialog,htdialog AS LONG
    
    
    
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
              ' Set a 1 milisec timer so as to show the initial perspective view
              ' using Case %WM_TIMER
              ' After which we stop the timer
                SetTimer(hDlg, %ID_Timer, 1, %NULL)
    
    
            CASE %WM_TIMER
              ' this will show an initial perspective view with
              ' the view port on the top right corner
              ' stop the timer after the first display
                KillTimer CB.HNDL, %ID_Timer
                DrawScene
    
    
           CASE %WM_SIZE
              ' Obtain the size of the existing dialog
               DIALOG GET CLIENT hDlg TO wdialog,htdialog
             ' Change the label or canvas size accordingly
               CONTROL SET SIZE hDlg, %ID_Label,wdialog-50,htdialog-70
               ResizeScene wdialog-50,htdialog-70
               DrawScene
    
    
           CASE %WM_PAINT
                DrawScene
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               KillTimer hDlg, %ID_Timer
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
    
     '=================================
    ' Prints out the cross section to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
     ' See how the bitmap gets printed out from
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-console-compiler/17364-printing-a-bmp-in-pbcc-40?p=229587#post229587
     ' and
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/54775-printing-a-bmp-file-with-xprint
    
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
    
      ' obtain the size of the temp bitmap file
      ' note that 19 and 23 are the offsets to get
      ' size of the bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       ' between upper left point xpr,ypr   and the
       ' lower right point at  xpr+wNew-1,ypr+hNew-10
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
       ' print the encompassing box with a thick width of 8
       XPRINT WIDTH 8
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "Cross section  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    
      ' Close the memory bitmap -- this is a must
      ' to prevent GDI errors
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
        SLEEP 20
       ' Remove the temp bitmap file
        KILL bmpFil
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw   AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw   AS DWORD
      LOCAL fbn   AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        CONTROL HANDLE hdlg, %ID_Label TO hLabel
        hDC = GetDC(hLabel)
       ' hDC = GetDC(hDlg)
    
        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 245,255,250,1
         glClearDepth 1         'zvalue to be used with glClear
     END SUB
    
    
    '=================================
     SUB ResizeScene (widSc AS LONG, htSc AS LONG)
        glViewport 0, 0, widSc, htSc             'resize viewport
        glMatrixMode %gl_projection       'select projection matrix
        glLoadIdentity                    'reset projection matrix
        gluPerspective 45, widSc/htSc, 0.1, 100  'set perspective aspect ratio
        glMatrixMode %gl_modelview        'select modelview matrix
     END SUB
    
    
    
    '=========================
     SUB DrawScene
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
        SwapBuffers hDC              'display the buffer (image)
     END SUB

    Click image for larger version

Name:	New openGL.png
Views:	132
Size:	1.9 KB
ID:	774414

    Leave a comment:


  • Stuart McLachlan
    replied
    Originally posted by Anne Wilson View Post
    The g.. sycophants strike again, LOL ... please keep your pillow talk to yourselves
    Please stop leeching off forum members for your commercial enterprise.

    Leave a comment:


  • Anne Wilson
    replied
    The g.. sycophants strike again, LOL ... please keep your pillow talk to yourselves

    Leave a comment:


  • Stuart McLachlan
    replied
    Originally posted by Bob Carver View Post

    Also Stuart, the links in your signature are broken
    Hmm, I don't see any signatures on posts and I can't see where to turn that on/off. Can anyone point me in the right direction?


    Edit: Never mind. I found it

    Hmmm, I see what you mean. Guess that sig is from the old forum website and this one doesn't like URLs the way they were formatted.

    Leave a comment:


  • Bob Carver
    replied
    Originally posted by Stuart McLachlan View Post

    Anyone else getting tired of being asked to write most of this commercial software for free?
    It's almost like I've been right all along! FYI, this company is Canadian and the reason they're still going with this in PB despite apparently migrating their code to every other 64-bit native language listed on Wikipedia is because they're quickly finding out that nobody who knows those languages will write it for them.

    Also Stuart, the links in your signature are broken

    Leave a comment:


  • Stuart McLachlan
    replied
    Originally posted by Anne Wilson View Post
    Thanks Dale, yippee it works now except that the dialog cannot be resize. Otherwise the buttons will disappear!

    Here's my code

    Can someone help by making the dialog resizable at the same time the buttons won't disappear ? TQ

    Try adding %WS_THICKFRAME in the following code and resize the dialog

    DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300, %WS_BORDER OR _
    %WS_VISIBLE OR %WS_THICKFRAME TO hDlg
    Anyone else getting tired of being asked to write most of this commercial software for free?

    Leave a comment:


  • Anne Wilson
    replied
    Thanks Dale, yippee it works now except that the dialog cannot be resize. Otherwise the buttons will disappear!

    Here's my code

    Can someone help by making the dialog resizable at the same time the buttons won't disappear ? TQ

    Try adding %WS_THICKFRAME in the following code and resize the dialog

    DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300, %WS_BORDER OR _
    %WS_VISIBLE OR %WS_THICKFRAME TO hDlg


    Code:
    'OpenGL Graphic Print.bas
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
     ' Thanks to Gary
    
    
       ' Program to XPRINT the OpenGL image to the printer  in 3 steps :
       ' 1.  Program generate the OpenGL image on the screen
       ' 2.  Pressing the print button will capture the image into a temp bitmap file
       ' 3.  It then loads the temp bitmap file and XPrint it to the printer
    
    
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
      %ID_Button1 = 1101
      %ID_Button2 = 1102
    
    
     GLOBAL hDlg , hDC, hRC AS DWORD
    
    
    '===================================
    ' Main program
     FUNCTION PBMAIN() AS LONG
    
     '  %WS_THICKFRAME is NOT use to ensure that the dialog cannot resize
     '  resizing the dialog can make the buttons dissappear
       DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE   TO hDlg
    
        CONTROL ADD BUTTON, hDlg, %ID_Button1,"Print the Cross section " ,20,5,150,20
    
        CONTROL ADD BUTTON, hDlg, %ID_Button2,"Exit" ,20,25,50,20
    
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL w,h AS LONG
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
                GetRenderContext
                InitializeScene
    
           CASE %WM_SIZE
               DIALOG GET CLIENT hDlg TO w,h
               ResizeScene w-50,h-50
               DrawScene
    
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Button1 THEN
                  ' capture the window into a bitmap
                   CaptureWindow hDlg
                   SLEEP 20
                  ' do the printing
                   PrintXSection_BitMap
               END IF
    
               IF CB.CTL=%ID_Button2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
     '=================================
    ' Prints out the cross section to the printer
    ' using the temp.bmp BitMap file that was obtained
    ' by the CaptureWindow() routine
    SUB PrintXSection_BitMap
    
       LOCAL xpr,ypr  AS LONG
       LOCAL hBMP AS DWORD
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
       LOCAL nFile AS LONG
       LOCAL bmpFil AS STRING
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
      ' The temporary bitmap filename
        bmpFil = "Temp.bmp"
    
      ' obtain the size of the temp bitmap file
        nFile = FREEFILE
        OPEN bmpFil FOR BINARY AS nFile
        GET #nFile, 19, wImg
        GET #nFile, 23, hImg
        CLOSE nFile
    
       GRAPHIC BITMAP LOAD bmpFil, wImg,hImg TO hBmp
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
    
    
       ' Prints out the bitmap image within the encompassing box
       XPRINT RENDER bmpFil, (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10)
    
    
         ' print the encompassing box
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print the title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "Cross section  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
        GRAPHIC ATTACH hBmp, 0
        GRAPHIC BITMAP END
    
    END SUB
    
    
    
    
    
    
    '==================================
    ' https://forum.powerbasic.com/forum/user-to-user-discussions/powerbasic-for-windows/46588-easiest-way-to-copy-the-content-of-the-active-window-to-the-clipboard?p=544678#post544678
    ' Capture the current dialog window image ( minus the borders and non client regions)
    ' into a temporary bitmap file
    SUB CaptureWindow(BYVAL hDWin AS DWORD)
      LOCAL hwDC   AS DWORD
      LOCAL hwMDC  AS DWORD
      LOCAL hMBmp AS DWORD
      LOCAL rcw, rborder, rframe    AS RECT
    
    
    
      LOCAL bmw    AS BITMAP
      LOCAL bmi   AS BITMAPINFO
      LOCAL bmpFH AS BITMAPFILEHEADER
      LOCAL wbw    AS DWORD
      LOCAL fbn    AS LONG
    
     ' Obtain the current window rectangle dimensions
       GETWINDOWRECT hDWin, rcw
      ' Removing the top non client portion and the borders
       rcw.top += 75
       rcw.left += 15
       rcw.right -= 15
       rcw.bottom -= 10
    
    
      hwDC = CreateDC("DISPLAY", BYVAL %Null, BYVAL %Null, BYVAL %Null)
      hwMDC = CreateCompatibleDC(hwDC)
      bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
      bmi.bmiHeader.biWidth = (rcw.nRight - rcw.nLeft)
      bmi.bmiHeader.biHeight = (rcw.nBottom - rcw.nTop)
      bmi.bmiHeader.biPlanes = 1
      bmi.bmiHeader.biBitCount = 32
      bmi.bmiHeader.biCompression = %BI_RGB
      hMBmp = CreateDIBSection(hwMDC, bmi, %DIB_RGB_COLORS, %NULL, 0, 0)
    
      SelectObject hwMDC, hMBmp
      GetObject hMBmp, SIZEOF(bmw), bmw
      BitBlt(hwMDC, 0, 0, bmw.bmWidth, bmw.bmHeight, hwDC, rcw.nLeft, rcw.nTop, %SRCCOPY)
    
      wbw = bmi.bmiHeader.biWidth + (bmi.bmiHeader.biWidth MOD 4)
      bmpFH.bfType = CVI("BM")
      bmpFH.bfOffBits = 54
      bmpFH.bfSize = SIZEOF(bmpFH) + (wbw * bmw.bmHeight)
    
      fbn = FREEFILE
      OPEN "temp.bmp" FOR OUTPUT AS #fbn
      PRINT #fbn, bmpFH; bmi.bmiHeader; PEEK$(bmw.bmBits, bmw.bmWidthBytes * bmw.bmHeight);
      CLOSE #fbn
    
      DeleteDC(hwDC)
      DeleteDC(hwMDC)
      DeleteObject(hMBmp)
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        hDC = GetDC(hDlg)
    
        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 245,255,250,1
        glClearDepth 1         'zvalue to be used with glClear
     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
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
        SwapBuffers hDC              'display the buffer (image)
     END SUB

    Leave a comment:


  • Dale Yarker
    replied
    Anne, also see Help for XPRINT STRETCH regarding second parameter.

    Leave a comment:


  • Stuart McLachlan
    replied
    Sigh! More copy.paste without understanding?
    CONTROL HANDLE hDlg, %ID_Graphic01 TO hGraphic (gives a handle to a CONTROL!)
    XPRINT STRETCH hGraphic, 0, ... (requires a handle to a BITMAP or GRAPHIC WINDOW )

    Leave a comment:


  • Tried to Xprint OpenGL graphics but got blank printout?

    I have adapted the following program from Gary https://forum.powerbasic.com/forum/u...raphic-control

    in order to print out OpenGL graphics using the XPRINT command. But the resultant printout is a blank printout devoid of graphics?

    How do I resolve this ?

    Code:
    'OpenGL Graphic Print.bas
    'https://forum.powerbasic.com/forum/user-to-user-discussions/special-interest-groups/programming-opengl/53901-combining-graphic-and-opengl-statements-in-a-graphic-control
    
     ' Thanks to Gary
    
     #COMPILE EXE
     #DIM ALL
    
     #INCLUDE "win32api.inc"
     #INCLUDE "gl.inc"
     #INCLUDE "glu.inc"
    
    
    
     %ID_Graphic01 = 1000
     %ID_Opt = 1006
     %ID_Opt2 = 1008
    
     GLOBAL hDlg, hGraphic, hDC, hRC AS DWORD
    
    
    '===================================
     FUNCTION PBMAIN() AS LONG
       DIALOG NEW PIXELS, 0, "OpenGL Graphic Print",,, 350,300,  %WS_BORDER    OR _
                %WS_VISIBLE  OR %WS_THICKFRAME TO hDlg
    
       CONTROL ADD GRAPHIC, hDlg, %ID_Graphic01, "",25,45,300,200, %WS_BORDER OR %SS_NOTIFY
       CONTROL HANDLE hDlg, %ID_Graphic01 TO hGraphic
    
       GRAPHIC ATTACH hDlg, %ID_Graphic01
       hDC = GetDC(hGraphic)
    
    
       CONTROL ADD OPTION, hDlg, %ID_Opt,"Print the Cross section " ,20,5,150,20
    
       CONTROL ADD OPTION, hDlg, %ID_Opt2,"Exit " ,20,25,50,20
    
       DIALOG SHOW MODAL hdlg CALL dlgproc
     END FUNCTION
    
    
    '===================================
     CALLBACK FUNCTION dlgproc()
        LOCAL w,h AS LONG
        SELECT CASE CB.MSG
           CASE %WM_INITDIALOG
               GetRenderContext
               InitializeScene
    
           CASE %WM_SIZE
               DIALOG GET CLIENT hDlg TO w,h
               CONTROL SET SIZE hDlg, %ID_Graphic01, w-50,h-50
               ResizeScene w-50,h-50
               DrawScene
    
    
            CASE %WM_COMMAND
               IF CB.CTL=%ID_Opt THEN
                 ' do the printing
                   PrintXSection
               END IF
               IF CB.CTL=%ID_Opt2 THEN
                   'exit
                   DIALOG END hDlg
               END IF
    
    
           CASE %WM_DESTROY
             ' // End the application
                PostQuitMessage 0
    
    
           CASE %WM_CLOSE
               wglmakecurrent %null, %null 'unselect rendering context
               wgldeletecontext hRC        'delete the rendering context
               releasedc hDlg, hDC         'release device context
    
        END SELECT
     END FUNCTION
    
    
    
    '=================================
    ' Prints the cross section
    SUB PrintXSection
    
       LOCAL xpr,ypr  AS LONG
    
       ' select a printer
       XPRINT ATTACH CHOOSE
    
       IF LEN(XPRINT$)=0 THEN
       '   When printer is not available
            EXIT SUB
       END IF
    
       ' prinOren = 1 for portrait or 2 for landscape
       XPRINT SET ORIENTATION 1
    
       LOCAL wNew,hNew,wImg,hImg,wCont,hCont AS  LONG
    
     ' wCont,hCont = container or canvas size of printer
       ' hImg,wImg = original image size of  %ID_Graphic01
       ' wNew,hNew = image size to fit in container
       CONTROL GET SIZE hDlg, %ID_Graphic01 TO wImg,hImg
    
    
    
      'Retrieves the writable canvas size of the attached host printer.
       XPRINT GET CANVAS TO wCont, hCont
       wNew = wImg / MAX(wImg / wCont, hImg / hCont) * 0.75
       hNew = hImg / MAX(wImg / wCont, hImg / hCont)  * 0.75
       'upper/left position so resized image is centered
        xpr = (wCont-wNew)/2
        ypr = (hCont-hNew)/2
    
      ' XPRINT WIDTH 5
    
       'copy (resized) from memory bitmap to visible image
       XPRINT STRETCH hGraphic, 0, (0,0)-(wImg-1,hImg-1) TO _
        (xpr,ypr)-(xpr+wNew-1,ypr+hNew-1)
    
    
       ' XPRINT STRETCH hGraphic, 0, (0,0)-(wImg,hImg) TO _
       ' (xpr,ypr)-(xpr+wNew,ypr+hNew)
    
    
       ' tried this but didn't work
       ' XPRINT STRETCH PAGE hDlg, %id_graphic01
    
    
      ' print the encompassing box
       XPRINT BOX (xpr,ypr)-(xpr+wNew-1,ypr+hNew-10),,%BLACK
    
    
        'print title
       XPRINT SET POS (xpr,ypr/2)
       XPRINT "Cross section  "
    
    
      ' Each XPRINT must be closed otherwise will cause problem
      ' like non printing and the document is suspended in the printer
        XPRINT CLOSE
    
    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_SUPPORT_GDI
                        '  %pfd_support_opengl Or %pfd_doublebuffer
        pfd.dwlayermask = %pfd_main_plane
        pfd.iPixelType  = %pfd_type_rgba
        pfd.ccolorbits  = 24
        pfd.cdepthbits  = 24
    
        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 245,255,250,1
        glClearDepth 1         'zvalue to be used with glClear
     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
        glClear %gl_color_buffer_bit OR %gl_depth_buffer_bit
        glLoadIdentity               'clear the modelview matrix
        glBegin %gl_triangles        'select triangles as primitive
           glcolor3ub 255,0,0        'set default vertex color
           glvertex3f  0, 1,  -4     'vertex1
           glvertex3f  -1, 0, -4     'vertex2
           glvertex3f  1, -1, -4     'vertex3
        glEnd
        SwapBuffers hDC              'display the buffer (image)
     END SUB
    The graphics on the screen is depicted as

    Click image for larger version

Name:	cross sect.png
Views:	80
Size:	1.5 KB
ID:	774378



    But if you try to print out by clicking on the "Print Cross section" button, the resultant printout is a blank print out.

Working...
X