Announcement

Collapse
No announcement yet.

Tried to Xprint OpenGL graphics but got blank printout?

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

  • 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:	1
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.


  • #2
    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 )

    Comment


    • #3
      Anne, also see Help for XPRINT STRETCH regarding second parameter.
      Dale

      Comment


      • #4
        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

        Comment


        • #5
          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?

          Comment


          • #6
            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

            Comment


            • #7
              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.

              Comment


              • #8
                The g.. sycophants strike again, LOL ... please keep your pillow talk to yourselves

                Comment


                • #9
                  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.

                  Comment


                  • #10
                    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:	1
Size:	1.9 KB
ID:	774414

                    Comment


                    • #11
                      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.
                      Dale

                      Comment


                      • #12
                        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, 03:24 AM.

                        Comment


                        • #13
                          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

                          Comment


                          • #14
                            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:	1
Size:	2.2 KB
ID:	774424

                            Comment


                            • #15
                              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

                              Comment


                              • #16
                                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

                                Comment


                                • #17
                                  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

                                  Comment


                                  • #18
                                    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?





                                    Comment


                                    • #19
                                      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?

                                      Comment

                                      Working...
                                      X