Announcement

Collapse
No announcement yet.

Drawing 3D contours

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

  • Drawing 3D contours

    Hi All

    Does anyone have some skeleton code to draw contours in 3D? Drawing contour lines joining ground levels in x, y, z coordinates and its plotting
    can be quite complicated

    Thanks in advance

  • #2
    Well:
    Gary,
    go to google and use the search string:
    site:www.powerbasic.com 3d

    Paul
    from this thread
    as well as this from that same thread.
    Rod
    "To every unsung hero in the universe
    To those who roam the skies and those who roam the earth
    To all good men of reason may they never thirst " - from "Heaven Help the Devil" by G. Lightfoot

    Comment


    • #3
      Thanks Rodney

      how to get the codes???? from http://www.jose.it-berater.org/smffo...p?topic=1139.0

      do I need to be a member of that forum?

      Comment


      • #4
        do I need to be a member of that forum?
        I would think you would and to my knowledge joining is pretty straightforward, I don't recall any complaints about joining that forum.
        Rod
        "To every unsung hero in the universe
        To those who roam the skies and those who roam the earth
        To all good men of reason may they never thirst " - from "Heaven Help the Devil" by G. Lightfoot

        Comment


        • #5
          Tim,

          Also take a look at this 3D code from Wayne Hill.

          Note a couple of tweaks for PBWin10..
          '--------------------------------------------------------------
          ' CCDraw.INC, PB/Win 7.0 Custom Control Draw, by Wayne Hill.
          '--------------------------------------------------------------
          ' MAPWINDOWPOINTS ... statements need 'rc' -> 'ByVal VarPtr(rc)' for PBWin10
          ' Add Sleep 1 to CCDPaint() to reduce load on CPU.

          The code comprises the source for a .BAS file followed by that for CCDraw.INC You'll need to save them as separate files in the same folder before compiling.
          Last edited by Dave Biggs; 2 Dec 2019, 06:10 AM. Reason: gr
          Rgds, Dave

          Comment


          • #6
            You might also like to check Hydesoft's DPLot Jr that includes headers and sample code for PB in their distribution.

            Click image for larger version

Name:	DplotJnr.PNG
Views:	110
Size:	10.7 KB
ID:	786976
            Rgds, Dave

            Comment


            • #7
              What about using OpenGL extensions:
              https://forum.powerbasic.com/forum/u...60138-3d-chart
              Patrice Terrier
              www.zapsolution.com
              www.objreader.com
              Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).

              Comment


              • #8
                Howdy, Tim!

                The gbPoints app I wrote a while back can plot surfaces from data points. You provide it with a grid of points, corresponding to elevation, and it would plot the corresponding surface as a 3D, rotatable image. There's a variety of plotting options to play with.

                Click image for larger version

Name:	gbpointsb.jpg
Views:	104
Size:	27.0 KB
ID:	786979

                Comment


                • #9
                  Hey Tim!

                  I've been thinking about your question a bit more. The graphs above are not contour "lines", but rather 3D representations of elevation. Do you also have the need to generate more standard contour lines such as are used in topography maps?

                  Flattening the 3D images but leaving color is similar to contour lines but not the same.

                  Comment


                  • #10
                    Thank you all, I will need to digest all these codes

                    Gary, what I really need is to able to plot graphically the points obtained from a ground survey x, y and z where x and y are 2D plan coordinates while z is the
                    ground height. And then to draw or plot approximated contours of same height connecting these points such as 200 ft , 400 ft , 500 ft .

                    Thus these points coordinates are random ground survey points and are not perfect points that are derived from 3D mathematical curves or functions

                    Comment


                    • #11
                      Hi Dave

                      I have modified Wayne's program according to what you have said in post #5
                      but I encountered an error in compiling to PB win10

                      Code:
                      Compiling "C:\Tmp\Graphic programs\3D Matrix rotation\3D Matrix Rotation.bas"
                      Error 480 in C:\Tmp\GRAPHIC PROGRAMS\3D MATRIX ROTATION\CCDRAW.INC(182:015):  Parameter mismatches definition
                        Line 182:         hDc = BeginPaint hWnd, PS

                      The codes are as follows
                      the main program
                      Code:
                      #PBFORMS CREATED V1.50
                      #COMPILE EXE
                      #DIM ALL
                      
                      ' https://forum.powerbasic.com/forum/user-to-user-discussions/source-code/25010-3d-matrix-dynamic-rotation-custom-control?p=292615#post292615
                      
                      '------------------------------------------------------------------------------
                      ' 3D Matrix Rotation by Wayne Hill -  PB/Win 7.0
                      '------------------------------------------------------------------------------
                      '   ** Includes **
                      '------------------------------------------------------------------------------
                      #PBFORMS BEGIN INCLUDES
                      %USEMACROS = 1
                      #IF NOT %DEF( %WINAPI )
                          #INCLUDE "WIN32API.INC"
                      #ENDIF
                      #IF NOT %DEF( %COMMCTRL_INC )
                          #INCLUDE "COMMCTRL.INC"
                      #ENDIF
                      #INCLUDE "PBForms.INC"
                      #PBFORMS END INCLUDES
                      
                      
                      '------------------------------------------------------------------------------
                      '------------------------------------------------------------------------------
                      '   ** Constants **
                      '------------------------------------------------------------------------------
                      #PBFORMS BEGIN CONSTANTS
                      %frm_dialog = 101
                      %cmd_draw = 102
                      %IDC_MSCTLS_TRACKBAR32_1 = 104
                      %IDC_MSCTLS_TRACKBAR32_2 = 105
                      %IDC_MSCTLS_TRACKBAR32_3 = 106
                      %IDC_LABEL1 = 107
                      %IDC_LABEL2 = 108
                      %IDC_LABEL3 = 109
                      %IDC_LABEL4 = 110
                      %IDC_LABEL5 = 111
                      %IDC_LABEL6 = 112
                      %IDC_MSCTLS_TRACKBAR32_4 = 113
                      %IDC_LABEL7 = 114
                      %IDC_LABEL8 = 115
                      %IDC_BUTTON1 = 116
                      %IDC_BUTTON2 = 117
                      %IDC_BUTTON3 = 118
                      %IDC_BUTTON4 = 119
                      %IDC_BUTTON5 = 120
                      %IDC_LABEL9 = 121
                      %IDC_LABEL10 = 122
                      #PBFORMS END CONSTANTS
                      '------------------------------------------------------------------------------
                      #INCLUDE "CCDraw.INC"       'CCDraw include file - See Below
                      '------------------------------------------------------------------------------
                      '   ** Declarations **
                      '------------------------------------------------------------------------------
                      DECLARE CALLBACK FUNCTION Showfrm_dialogProc( )
                      DECLARE FUNCTION Showfrm_dialog( BYVAL hParent AS DWORD ) AS LONG
                      DECLARE SUB SetTrackBars( hWnd AS LONG, X AS LONG, Y AS LONG, Z AS LONG )
                      
                      #PBFORMS DECLARATIONS
                      '------------------------------------------------------------------------------
                      '------------------------------------------------------------------------------
                      '   ** Main Application Entry Point **
                      '------------------------------------------------------------------------------
                      FUNCTION PBMAIN( )
                          PBFormsInitComCtls( %ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES )
                      
                          Showfrm_dialog %HWND_DESKTOP
                      END FUNCTION
                      '------------------------------------------------------------------------------
                      '------------------------------------------------------------------------------
                      '   ** CallBacks **
                      '------------------------------------------------------------------------------
                      CALLBACK FUNCTION Showfrm_dialogProc( )
                      
                          LOCAL hTrackX AS DWORD
                          LOCAL hTrackY AS DWORD
                          LOCAL hTrackZ AS DWORD
                          LOCAL hScale AS DWORD
                          LOCAL hZoom AS LONG
                      
                          LOCAL rc AS RECT
                      
                      
                          SELECT CASE AS LONG CBMSG
                              CASE %WM_SIZE       'resize control if parent is resized
                                  IF CBWPARAM <> %SIZE_MINIMIZED THEN
                                      GETWINDOWRECT ghCCD, rc     ' get control's coordinates on screen
                                      MAPWINDOWPOINTS 0, CBHNDL, BYVAL VARPTR(rc), 2        ' map result to dialog
                                      SETWINDOWPOS ghCCD, 0, 0, 0, LOWRD( CBLPARAM ) - rc.nleft - 10, _       ' width
                                        HIWRD( CBLPARAM ) - rc.nTop - 10, _       ' height
                                        %SWP_NOMOVE OR %SWP_NOZORDER
                                      INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                                  END IF
                              CASE %WM_HSCROLL
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
                                  gXROT = SENDMESSAGE( hTrackX, %TBM_GETPOS, 0, 0 )
                                  CONTROL SET TEXT CBHNDL, %IDC_LABEL1, STR$( gXROT )
                                  gYROT = SENDMESSAGE( hTrackY, %TBM_GETPOS, 0, 0 )
                                  CONTROL SET TEXT CBHNDL, %IDC_LABEL2, STR$( gYROT )
                                  gZROT = SENDMESSAGE( hTrackZ, %TBM_GETPOS, 0, 0 )
                                  CONTROL SET TEXT CBHNDL, %IDC_LABEL3, STR$( gZROT )
                                  gMScale = SENDMESSAGE( hScale, %TBM_GETPOS, 0, 0 )
                                  CONTROL SET TEXT CBHNDL, %IDC_LABEL8, STR$( gMScale ) + "%"
                                  INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                      
                              CASE %WM_INITDIALOG
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
                                  SENDMESSAGE hTrackX, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 )     ' Set min. & max. positions
                                  SENDMESSAGE hTrackX, %TBM_SETPOS, %TRUE, 360        ' Set current position
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
                                  SENDMESSAGE hTrackY, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 )     ' Set min. & max. positions
                                  SENDMESSAGE hTrackY, %TBM_SETPOS, %TRUE, 360        ' Set current position
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
                                  SENDMESSAGE hTrackZ, %TBM_SETRANGE, %TRUE, MAKLNG( 0, 360 * 2 )     ' Set min. & max. positions
                                  SENDMESSAGE hTrackZ, %TBM_SETPOS, %TRUE, 360        ' Set current position
                                  CONTROL HANDLE CBHNDL, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
                                  SENDMESSAGE hScale, %TBM_SETRANGE, %TRUE, MAKLNG( 1, 1500 )     ' Set min. & max. positions
                                  SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, 100     ' Set current position
                                  gMScale = 100
                                  INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                              CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK     'start selrect draw
                                  gMouseDownInParent = 1
                      
                              CASE %WM_COMMAND
                                  SELECT CASE AS LONG CBCTL
                                      CASE %CMD_draw
                                          IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                                              DIALOG END CBHNDL
                                          END IF
                                      CASE %IDC_BUTTON1
                                          IF CBCTLMSG = %BN_CLICKED THEN
                                              gXRot = 360 : gYRot = 360 : gZRot = 360
                                              SetTrackBars( CBHNDL, 360, 360, 360 )
                                          END IF
                                      CASE %IDC_BUTTON2
                                          IF CBCTLMSG = %BN_CLICKED THEN
                                              gXRot = 270 : gYRot = 360 : gZRot = 360
                                              SetTrackBars( CBHNDL, 270, 360, 360 )
                                          END IF
                                      CASE %IDC_BUTTON3
                                          IF CBCTLMSG = %BN_CLICKED THEN
                                              gXRot = 270 : gYRot = 360 : gZRot = 270
                                              SetTrackBars( CBHNDL, 270, 360, 270 )
                                          END IF
                                      CASE %IDC_BUTTON4
                                          IF CBCTLMSG = %BN_CLICKED THEN
                                              gXRot = 310 : gYRot = 360 : gZRot = 225
                                              SetTrackBars( CBHNDL, 310, 360, 225 )
                                          END IF
                                      CASE %IDC_BUTTON5
                                          IF CBCTLMSG = %BN_CLICKED THEN
                                              CONTROL HANDLE CBHNDL, %IDC_BUTTON5 TO hZoom
                                              IF SENDMESSAGE( hZoom, %BM_GETCHECK, 0, 0 ) = %BST_CHECKED THEN
                                                  gZoomStatus = 1     'On
                                              ELSE
                                                  gZoomStatus = 0     'Off
                                              END IF
                                          END IF
                                  END SELECT
                          END SELECT
                      END FUNCTION
                      '------------------------------------------------------------------------------
                      '------------------------------------------------------------------------------
                      '   ** Dialogs **
                      '------------------------------------------------------------------------------
                      FUNCTION Showfrm_dialog( BYVAL hParent AS DWORD ) AS LONG
                          LOCAL lRslt AS LONG
                      #PBFORMS BEGIN DIALOG %frm_dialog->->
                          LOCAL hDlg AS DWORD
                      
                          DIALOG NEW hParent, "3D Matrix Rotation", 153, 51, 414, 357, %WS_POPUP _
                            OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _
                            %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
                            OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE _
                            OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
                            %WS_EX_RIGHTSCROLLBAR, TO hDlg
                          CONTROL ADD BUTTON, hDlg, %cmd_draw, "Exit", 355, 10, 44, 16
                          CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_1, _
                            "msctls_trackbar32_1", 25, 5, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
                            %TBS_HORZ OR %TBS_BOTTOM
                          CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_2, _
                            "msctls_trackbar32_2", 25, 20, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
                            %TBS_HORZ OR %TBS_BOTTOM
                          CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_3, _
                            "msctls_trackbar32_3", 25, 35, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
                            %TBS_HORZ OR %TBS_BOTTOM
                          CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_4, _
                            "msctls_trackbar32_4", 25, 50, 305, 15, %WS_CHILD OR %WS_VISIBLE OR _
                            %TBS_HORZ OR %TBS_BOTTOM
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "360", 330, 5, 20, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL2, "360", 330, 20, 20, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL3, "360", 330, 35, 20, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL4, "X", 5, 5, 15, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL5, "Y", 5, 20, 15, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL6, "Z", 5, 35, 15, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL7, "Scale", 5, 50, 20, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL8, "100%", 330, 50, 30, 10
                          CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "XY", 10, 70, 20, 15
                          CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "XZ", 35, 70, 20, 15
                          CONTROL ADD BUTTON, hDlg, %IDC_BUTTON3, "YZ", 60, 70, 20, 15
                          CONTROL ADD BUTTON, hDlg, %IDC_BUTTON4, "ISO", 85, 70, 20, 15
                          CONTROL ADD BUTTON, hDlg, %IDC_BUTTON5, "Zoom", 110, 70, 30, 15, _
                            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR _
                            %BS_DEFPUSHBUTTON OR %BS_PUSHLIKE OR %BS_AUTOCHECKBOX OR %BS_CENTER _
                            OR %BS_VCENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
                          DIALOG SEND hDlg, %DM_SETDEFID, %IDC_BUTTON5, 0
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL9, "Label9", 155, 70, 55, 10
                          CONTROL ADD LABEL, hDlg, %IDC_LABEL10, "Label10", 215, 70, 50, 10
                      #PBFORMS END DIALOG
                          ghCCD = CreateCcd( hDlg, %ID_CCD, 10, 90, 80, 60, _
                            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP _
                            , %WS_EX_CLIENTEDGE )
                      
                          DIALOG SHOW MODAL hDlg, CALL Showfrm_dialogProc TO lRslt
                      
                      #PBFORMS BEGIN CLEANUP %frm_dialog
                      #PBFORMS END CLEANUP
                          FUNCTION = lRslt
                      END FUNCTION
                      
                      SUB SetTrackBars( hWnd AS LONG, X AS LONG, Y AS LONG, Z AS LONG )
                          LOCAL hTrackX AS DWORD
                          LOCAL hTrackY AS DWORD
                          LOCAL hTrackZ AS DWORD
                          LOCAL hScale AS DWORD
                          CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_1 TO hTrackX
                          CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_2 TO hTrackY
                          CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_3 TO hTrackZ
                          CONTROL HANDLE hWnd, %IDC_MSCTLS_TRACKBAR32_4 TO hScale
                      
                          SENDMESSAGE hTrackX, %TBM_SETPOS, %TRUE, X
                          SENDMESSAGE hTrackY, %TBM_SETPOS, %TRUE, Y
                          SENDMESSAGE hTrackZ, %TBM_SETPOS, %TRUE, Z
                          SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, 100
                      
                          gMscale = 100
                          gFirstTime = %TRUE
                          CONTROL SET TEXT hWnd, %IDC_LABEL1, STR$( gXROT )
                          CONTROL SET TEXT hWnd, %IDC_LABEL2, STR$( gYROT )
                          CONTROL SET TEXT hWnd, %IDC_LABEL3, STR$( gZROT )
                          CONTROL SET TEXT hWnd, %IDC_LABEL8, STR$( gMscale )
                      
                          INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                      END SUB

                      and the CCDraw.inc
                      Code:
                      '--------------------------------------------------------------
                      ' CCDraw.INC, PB/Win 7.0 Custom Control Draw, by Wayne Hill.
                      '--------------------------------------------------------------
                      GLOBAL gXROT AS DOUBLE
                      GLOBAL gYROT AS DOUBLE
                      GLOBAL gZROT AS DOUBLE
                      GLOBAL ghCCD AS LONG
                      GLOBAL gMScale AS LONG
                      GLOBAL gxGridZero AS LONG
                      GLOBAL gyGridZero AS LONG
                      GLOBAL gZoomStatus AS LONG
                      
                      GLOBAL gPt AS POINTAPI, gRc AS RECT
                      GLOBAL gPrevPt AS POINTAPI
                      
                      GLOBAL gMouseDownInParent AS LONG
                      GLOBAL gxOffset AS LONG, gYoffset AS LONG
                      GLOBAL gFirstTime AS LONG
                      
                      'Equates
                      %ID_CCD = 150
                      DECLARE SUB Matrix( hWnd AS DWORD, X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, Xpoint AS LONG, Xpoint AS LONG )
                      DECLARE FUNCTION CreateCCD( BYVAL hWnd AS LONG, BYVAL CtrlId AS LONG, _
                        BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
                        BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
                        BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG ) AS LONG
                      
                      DECLARE FUNCTION ctlWndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                        BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
                      
                      DECLARE FUNCTION ccdPaint( BYVAL hWnd AS LONG, BYVAL wParam AS LONG ) AS LONG
                      DECLARE SUB DRAWCIRCLE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG, radius AS LONG )
                      DECLARE SUB DRAWLINE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG )
                      
                      DECLARE SUB selRectBegin( BYVAL hWnd AS DWORD )
                      DECLARE SUB selRectDraw( BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG )
                      DECLARE SUB selRectEnd( BYVAL hWnd AS DWORD )
                      
                      
                      SUB Matrix( hWnd AS DWORD, X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE, Xpoint AS LONG, Ypoint AS LONG )
                      
                          LOCAL XSIN AS DOUBLE, YSIN AS DOUBLE, ZSIN AS DOUBLE
                          LOCAL XCOS AS DOUBLE, YCOS AS DOUBLE, ZCOS AS DOUBLE
                          LOCAL RMX1 AS DOUBLE, RMX2 AS DOUBLE, RMY1 AS DOUBLE
                          LOCAL RMY2 AS DOUBLE, RMZ1 AS DOUBLE, RMZ2 AS DOUBLE
                          LOCAL D2R AS DOUBLE
                          LOCAL wRect AS RECT
                      
                          D2R = 0.0174532925199433
                          XSIN = SIN( gXROT * D2R ) : YSIN = SIN( gYROT * D2R ) : ZSIN = SIN( gZROT * D2R )
                          XCOS = COS( gXROT * D2R ) : YCOS = COS( gYROT * D2R ) : ZCOS = COS( gZROT * D2R )
                          RMX1 = YCOS * ZCOS
                          RMY1 = - ZSIN * YCOS
                          RMZ1 = YSIN
                          RMX2 = ZCOS * - YSIN * - XSIN + ZSIN * XCOS
                          RMY2 = - ZSIN * - YSIN * - XSIN + ZCOS * XCOS
                          RMZ2 = YCOS * - XSIN
                          Xpoint = (( X * RMX1 ) + ( Y * RMY1 ) + ( Z * RMZ1 )) * gMScale
                          Ypoint = (( X * RMX2 ) + ( Y * RMY2 ) + ( Z * RMZ2 )) * gMScale
                      
                          IF SGN( Ypoint ) THEN Ypoint = - Ypoint     ' Mirror -X for Dialog inverse
                      
                          GETCLIENTRECT hWnd, wRect
                          gxOffset = ( wRect.nRight / 2 ) + gxGridZero
                          gyOffset = ( wRect.nBottom / 2 ) + gyGridZero
                          Xpoint = Xpoint + gxOffset
                          Ypoint = Ypoint + gyOffset
                      END SUB
                      
                      ' Create control
                      FUNCTION CreateCCD( BYVAL hWnd AS LONG, BYVAL CtrlId AS LONG, _
                            BYVAL vLeft AS LONG, BYVAL vTop AS LONG, _
                            BYVAL vWidth AS LONG, BYVAL vHeight AS LONG, _
                            BYVAL wStyle AS LONG, BYVAL wStyleEx AS LONG ) AS LONG
                      
                          LOCAL hCcd AS LONG
                          LOCAL wc AS WNDCLASSEX
                          LOCAL szClassName AS ASCIIZ * 20
                      
                          szClassName = "CCDRAW"
                          IF GETCLASSINFOEX( GETMODULEHANDLE( BYVAL %NULL ), szClassName, wc ) = 0 THEN
                              wc.cbSize = SIZEOF( wc )
                              wc.style = %CS_DBLCLKS OR %CS_CLASSDC
                              wc.lpfnWndProc = CODEPTR( ctlWndProc )
                              wc.cbWndExtra = 4
                              wc.hInstance = GETMODULEHANDLE( BYVAL %NULL )
                              wc.hCursor = LOADCURSOR ( %NULL, BYVAL %IDC_CROSS )
                              wc.lpszClassName = VARPTR( szClassName )
                              REGISTERCLASSEX wc      'register new class
                              IF ERR THEN EXIT FUNCTION       'something bad
                          END IF
                      
                          CONTROL ADD "CCDRAW", hWnd, CtrlId, "", vLeft, vTop, vWidth, vHeight, wStyle, wStyleEx
                          CONTROL HANDLE hWnd, CtrlId TO hCcd
                      
                          gFirstTime = %TRUE
                      
                          FUNCTION = hCcd     'return the handle
                      END FUNCTION
                      
                      ' Main Message Handling
                      FUNCTION ctlWndProc( BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
                            BYVAL wParam AS LONG, BYVAL lParam AS LONG ) AS LONG
                          DIM HoldPos AS POINTAPI
                          LOCAL hDC AS LONG
                          SELECT CASE wMsg
                      
                              CASE %WM_LBUTTONDOWN, %WM_LBUTTONDBLCLK     'start selrect draw
                                  selRectBegin hWnd
                                  gMouseDownInParent = 0
                      
                              CASE %WM_MOUSEMOVE
                                  IF gMouseDownInParent THEN EXIT FUNCTION
                      
                                  GETCURSORPOS HoldPos
                                  SCREENTOCLIENT hWnd, HoldPos
                                  CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL9, STR$( HoldPos.x )
                                  CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL10, STR$( HoldPos.y )
                                  IF ( wParam AND %MK_LBUTTON ) THEN      'if mouse button is down while moved, draw rect
                                      selRectDraw hWnd, LOWRD( lParam ), HIWRD( lParam )
                                               INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD      ' Redraw Window
                                  END IF
                      
                              CASE %WM_LBUTTONUP      'mouse button released - end draw
                                  selRectEnd hWnd
                                  gMouseDownInParent = 0
                      
                              CASE %WM_ERASEBKGND : FUNCTION = 1      ' Don't erase background
                      
                              CASE %WM_PAINT : FUNCTION = ccdPaint( hWnd, wParam )
                              CASE %WM_DESTROY
                                  hDc = GETDC( hWnd )
                                  DELETEDC( hDC )
                      
                              CASE ELSE : FUNCTION = DEFWINDOWPROC( hWnd, wMsg, wParam, lParam )      'default message processing
                          END SELECT
                      
                      END FUNCTION
                      
                      ' WM_PAINT message handler
                      FUNCTION ccdPaint( BYVAL hWnd AS LONG, BYVAL wParam AS LONG ) AS LONG
                          LOCAL wRect AS RECT
                          LOCAL hBrush AS LONG
                      
                          LOCAL YellowPen AS DWORD
                          LOCAL RedPen AS DWORD
                          LOCAL BluePen AS DWORD
                          LOCAL GreenPen AS DWORD
                          LOCAL BrownPen AS DWORD
                          LOCAL GridLine AS DWORD
                      
                          SLEEP 1
                      
                          'Create Pens
                          RedPen = CREATEPEN( %PS_SOLID, 10, RGB( 255, 0, 0 ))
                          YellowPen = CREATEPEN( %PS_SOLID, 10, RGB( 255, 255, 0 ))
                          GreenPen = CREATEPEN( %PS_SOLID, 10, RGB( 150, 255, 100 ))
                          BluePen = CREATEPEN( %PS_SOLID, 10, RGB( 0, 0, 255 ))
                          BrownPen = CREATEPEN( %PS_SOLID, 10, RGB( 150, 100, 50 ))
                          GridLine = CREATEPEN( %PS_DOT, 0, RGB( 0, 0, 0 ))
                      
                          LOCAL hDC AS LONG
                          DIM mpx AS LONG
                          DIM mpy AS LONG
                          DIM mpx2 AS LONG
                          DIM mpy2 AS LONG
                      
                          DIM Axes AS DOUBLE
                          DIM Cage AS DOUBLE
                          DIM Helix AS DOUBLE
                          DIM I AS LONG
                      
                          DIM X AS DOUBLE, Y AS DOUBLE, Z AS DOUBLE
                          '''''''''''''''''''''''''''''
                          LOCAL hDCmem AS LONG
                          LOCAL hbmMem AS LONG
                          LOCAL hbmOld AS LONG
                          LOCAL hPen AS LONG
                              LOCAL PS AS PAINTSTRUCT
                          CALL GETCLIENTRECT( hWnd, wRect )
                      
                              hDc = BeginPaint hWnd, PS
                      
                          hDCmem = CREATECOMPATIBLEDC( hdc ) ' Create off-screen DC
                          hbmMem = CREATECOMPATIBLEBITMAP( hdc, wRect.nRight, wRect.nBottom )
                          hbmOld = SELECTOBJECT( hDCmem, hbmMem )
                          FILLRECT hDCmem, wRect, GETSTOCKOBJECT( %WHITE_BRUSH ) 'Paint Background
                          SETBKMODE hDCmem, %TRANSPARENT
                      
                          Helix = .875
                         ' Draw Quad Helix
                          FOR i = 0 TO 360 STEP 10
                              X = COS( I * ( 3.14159 / 180 )) * ( Helix )
                              Y = SIN( I * ( 3.14159 / 180 )) * ( Helix )
                              Z = ( Helix * 2 ) * ( i / 360 ) - Helix
                              Matrix( hWnd, X, Y, Z, mpx, mpy )
                              CALL DRAWCIRCLE( hDCmem, RedPen, mpx, mpy, mpx, mpy, 3 )
                              X = COS(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
                              Y = SIN(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
                              Matrix( hWnd, X, Y, Z, mpx, mpy )
                              CALL DRAWCIRCLE( hDCmem, BluePen, mpx, mpy, mpx, mpy, 3 )
                              X = COS(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
                              Y = SIN(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
                              Matrix( hWnd, X, Y, Z, mpx, mpy )
                              CALL DRAWCIRCLE( hDCmem, GreenPen, mpx, mpy, mpx, mpy, 3 )
                              X = COS(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
                              Y = SIN(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
                              Matrix( hWnd, X, Y, Z, mpx, mpy )
                              CALL DRAWCIRCLE( hDCmem, YellowPen, mpx, mpy, mpx, mpy, 3 )
                          NEXT I
                      
                          Cage = 1.0
                      
                          ' Draw cage
                          Matrix( hWnd, Cage, Cage, Cage, mpx, mpy )
                          Matrix( hWnd, - Cage, Cage, Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, - Cage, - Cage, Cage, mpx, mpy )
                          CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
                          Matrix( hWnd, Cage, - Cage, Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, Cage, Cage, Cage, mpx, mpy )
                          CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
                          Matrix( hWnd, Cage, Cage, - Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, - Cage, Cage, - Cage, mpx, mpy )
                          CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
                          Matrix( hWnd, - Cage, - Cage, - Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, Cage, - Cage, - Cage, mpx, mpy )
                          CALL DRAWLINE( hDCmem, GridLine, mpx2, mpy2, mpx, mpy )
                          Matrix( hWnd, Cage, - Cage, Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, Cage, - Cage, - Cage, mpx, mpy )
                          Matrix( hWnd, Cage, Cage, - Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, - Cage, Cage, - Cage, mpx, mpy )
                          Matrix( hWnd, - Cage, Cage, Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                          Matrix( hWnd, - Cage, - Cage, - Cage, mpx, mpy )
                          Matrix( hWnd, - Cage, - Cage, Cage, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )
                      
                          ' Draw Axes
                          Axes = 1.25
                          Matrix( hWnd, - Axes, 0, 0, mpx, mpy )
                          Matrix( hWnd, Axes, 0, 0, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )     ' X Axis
                          TEXTOUT hDCmem, mpx2, mpy2, "X", LEN( "X" )
                          Matrix( hWnd, 0, Axes, 0, mpx, mpy )
                          TEXTOUT hDCmem, mpx, mpy, "Y", LEN( "Y" )
                          Matrix( hWnd, 0, - Axes, 0, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )     ' Y Axis
                          Matrix( hWnd, 0, 0, Axes, mpx, mpy )
                          TEXTOUT hDCmem, mpx, mpy, "Z", LEN( "Z" )
                          Matrix( hWnd, 0, 0, - Axes, mpx2, mpy2 )
                          CALL DRAWLINE( hDCmem, GridLine, mpx, mpy, mpx2, mpy2 )     ' Z Axis
                      
                          IF gZoomStatus THEN     ' Paint Zoom Window as needed
                              hBrush = SELECTOBJECT( hDCmem, GETSTOCKOBJECT( %NULL_BRUSH ))       'for hollow rect
                              hPen = SELECTOBJECT( hDCmem, CREATEPEN( %PS_SOLID, 2, GETSYSCOLOR ( %COLOR_3DSHADOW )))     'create pen
                              RECTANGLE hDCmem, gRc.nLeft, gRc.nTop, gRc.nRight + 1, gRc.nBottom + 1      'draw rect
                              DELETEOBJECT SELECTOBJECT( hDCmem, hPen )       'Destroy hPen
                              DELETEOBJECT SELECTOBJECT( hDCmem, hBrush )     'Destroy hBrush
                          END IF
                          ' Copy Off-screen DC to Screen DC
                          BITBLT( hDC, wRect.nLeft, _
                            wRect.nTop, wRect.nRight - wRect.nLeft, _
                            wRect.nBottom - wRect.nTop, _
                            hDCmem, 0, 0, %SRCCOPY )
                      
                          SELECTOBJECT( hDCmem, hbmOld )
                          DELETEOBJECT hbmMem
                          DELETEDC( hDCmem )
                          EndPaint hWnd, PS
                      
                          'Destroy Pens
                          DELETEOBJECT RedPen
                          DELETEOBJECT YellowPen
                          DELETEOBJECT GreenPen
                          DELETEOBJECT BluePen
                          DELETEOBJECT BrownPen
                          DELETEOBJECT GridLine
                      END FUNCTION
                      
                      SUB DRAWCIRCLE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG, radius AS LONG )
                          SELECTOBJECT( MemDC, hPen )     'Get Virtual Pen ready
                          ELLIPSE MemDC, fromX - radius, fromY - radius, ToX + radius, ToY + radius
                      END SUB
                      
                      SUB DRAWLINE( MemDC AS DWORD, hPen AS DWORD, fromX AS LONG, fromY AS LONG, ToX AS LONG, ToY AS LONG )
                          DIM PrevPos AS POINTAPI
                          SELECTOBJECT( MemDC, hPen )     'Get Virtual Pen ready
                          MOVETOEX MemDC, fromX, fromY, PrevPos       'Move Virtual Pen
                          LINETO MemDC, ToX, ToY      'Draw on Virual DC
                          MOVETOEX MemDC, PrevPos.x, PrevPos.y, PrevPos       'Return to previous postion
                      END SUB
                      
                      SUB selRectBegin( BYVAL hWnd AS DWORD )
                          LOCAL rc AS RECT
                          SELECT CASE gZoomStatus
                              CASE 0
                                  SETCAPTURE hWnd     ' set capture to desired window
                                  GETCLIENTRECT hWnd, rc      ' get client size
                                  MAPWINDOWPOINTS hWnd, 0, BYVAL VARPTR(rc), 2      ' map client coordiantes to screen
                                  CLIPCURSOR rc       ' clip cursor to client coordinates
                                  GETCURSORPOS gPt        ' get cursor pos on screen
                                  SCREENTOCLIENT hWnd, gPt        ' convert to client coordinates
                                  gPrevPt.x = gPt.x       'INI Mouse Point X-Y
                                  gPrevPt.y = gPt.y
                              CASE 1
                                  SETCAPTURE hWnd     ' set capture to desired window
                                  GETCLIENTRECT hWnd, rc      ' get client size
                                  MAPWINDOWPOINTS hWnd, 0, BYVAL VARPTR(rc), 2      ' map client coordiantes to screen
                                  CLIPCURSOR rc       ' clip cursor to client coordinates
                                  GETCURSORPOS gPt        ' get cursor pos on screen
                                  SCREENTOCLIENT hWnd, gPt        ' convert to client coordinates
                          END SELECT
                          INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                      END SUB
                      
                      SUB selRectDraw( BYVAL hWnd AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG )
                      
                          SELECT CASE gZoomStatus
                              CASE 0
                                  GETCURSORPOS gPt        ' get cursor pos on screen
                                  SCREENTOCLIENT hWnd, gPt
                                  gxGridZero = gxGridZero + ( gPt.X - gPrevPt.x )
                                  gyGridZero = gyGridZero + ( gPt.Y - gPrevPt.Y )     '
                                  gPrevPt.x = gPt.x       ' Store Mouse Position X + Y
                                  gPrevPt.y = gPt.y
                      
                              CASE 1
                                  ' must make sure rect coordinates are correct,
                                  ' so right side always is larger than left, etc.
                                  IF ( gPt.x < = x ) AND ( gPt.y > = y ) THEN
                                      SETRECT gRc, gPt.x, y, x, gPt.y
                                  ELSEIF ( gPt.x > x ) AND ( gPt.y > y ) THEN
                                      SETRECT gRc, x, y, gPt.x, gPt.y
                                  ELSEIF ( gPt.x > = x ) AND ( gPt.y < = y ) THEN
                                      SETRECT gRc, x, gPt.y, gPt.x, y
                                  ELSE
                                      SETRECT gRc, gPt.x, gPt.y, x, y
                                  END IF
                      
                                  IF gRc.nLeft = gRc.nRight THEN INCR gRc.nRight      '<- ensure we never get a "null rect"
                                  IF gRc.nTop = gRc.nBottom THEN INCR gRc.nBottom
                                  ' Let Virtual DC do rectangle draw
                      
                          END SELECT
                      END SUB
                      
                      SUB selRectEnd( BYVAL hWnd AS DWORD )
                          LOCAL rc AS RECT
                          DIM CenterBox AS POINTAPI
                          DIM CenterScreen AS POINTAPI
                          LOCAL xs AS DOUBLE, ys AS DOUBLE
                          LOCAL hScale AS LONG
                          LOCAL NewScale AS LONG
                      
                          SELECT CASE gZoomStatus
                              CASE 0
                                  RELEASECAPTURE
                                  CLIPCURSOR BYVAL %NULL
                              CASE 1
                                  RELEASECAPTURE
                                  CLIPCURSOR BYVAL %NULL
                                  GETCURSORPOS gPt        ' get cursor pos on screen
                                  SCREENTOCLIENT hWnd, gPt
                                  GETCLIENTRECT hWnd, rc
                                  CenterScreen.x = Rc.nRight / 2
                                  CenterScreen.y = Rc.nBottom / 2
                                  CenterBox.x = ( gRc.nRight + gRc.nLeft ) / 2
                                  CenterBox.y = ( gRc.nBottom + gRc.nTop ) / 2
                                  ' Scale Drawing by ratio of ZoomBox to Screen size
                                  xs = rc.nRight \ ( gRc.nRight - gRc.nLeft )
                                  ys = rc.nBottom \ ( gRc.nBottom - gRc.nTop )
                                  NewScale = MAX( xs, ys )
                                  ' Calculate the difference from GridZero
                                  ' and center of screen then offset scale by difference.
                                  gxOffset = ( CenterScreen.x - CenterBox.x )
                                  gYoffset = ( CenterScreen.y - CenterBox.y )
                                  gxGridZero = gxGridZero + ( gxOffset * xs )
                                  gyGridZero = gyGridZero + ( gYoffset * ys )
                                  gMscale = gMscale * NewScale
                                  CONTROL HANDLE GETPARENT( hWnd ), %IDC_MSCTLS_TRACKBAR32_4 TO hScale
                                  SENDMESSAGE hScale, %TBM_SETPOS, %TRUE, gMscale
                                  CONTROL SET CHECK GETPARENT( hWnd ), %IDC_BUTTON5, 0
                                  gZoomStatus = 0
                                  CONTROL SET TEXT GETPARENT( hWnd ), %IDC_LABEL8, STR$( gMscale )
                                  gRc.nLeft = 0
                                  gRc.nTop = 0
                                  gRc.nRight = 0
                                  gRc.nBottom = 0
                                  INVALIDATERECT ghCCD, BYVAL %NULL, 0 : UPDATEWINDOW ghCCD       ' Redraw Window
                          END SELECT
                      END SUB

                      Comment


                      • #12
                        Hi Tim,

                        Line 182 of CCDRAW.INC needs parentheses..
                        Code:
                                hDc = BeginPaint( hWnd, PS )
                        I forget when parentheses became mandatory if assigning a functions return value.

                        I still had the original source code on my PC. The source code on the forum was updated following this discussion
                        - Which incidentally also made the 'SLEEP 1' fix unnecessary too : )


                        Rgds, Dave

                        Comment


                        • #13
                          Thanks Dave, only 2 brackets that can cause such error Whew!

                          BTW, I believe the following codes in the FUNCTION ccdPaint() is the function that display the points for X, Y and Z
                          and if I replace these points with arrays of ground points X() , Y() , Z() then I would be able to display a 3D drawing of ground level
                          points. Am I correct in this assumption ?



                          Code:
                            Helix = .875
                             ' Draw Quad Helix
                              FOR i = 0 TO 360 STEP 10
                                  X = COS( I * ( 3.14159 / 180 )) * ( Helix )
                                  Y = SIN( I * ( 3.14159 / 180 )) * ( Helix )
                                  Z = ( Helix * 2 ) * ( i / 360 ) - Helix
                                  Matrix( hWnd, X, Y, Z, mpx, mpy )
                                  CALL DRAWCIRCLE( hDCmem, RedPen, mpx, mpy, mpx, mpy, 3 )
                                  X = COS(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
                                  Y = SIN(( I + 90 ) * ( 3.14159 / 180 )) * ( Helix )
                                  Matrix( hWnd, X, Y, Z, mpx, mpy )
                                  CALL DRAWCIRCLE( hDCmem, BluePen, mpx, mpy, mpx, mpy, 3 )
                                  X = COS(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
                                  Y = SIN(( I + 180 ) * ( 3.14159 / 180 )) * ( Helix )
                                  Matrix( hWnd, X, Y, Z, mpx, mpy )
                                  CALL DRAWCIRCLE( hDCmem, GreenPen, mpx, mpy, mpx, mpy, 3 )
                               '   X = COS(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
                               '   Y = SIN(( I + 270 ) * ( 3.14159 / 180 )) * ( Helix )
                               '   Matrix( hWnd, X, Y, Z, mpx, mpy )
                                '  CALL DRAWCIRCLE( hDCmem, YellowPen, mpx, mpy, mpx, mpy, 3 )
                              NEXT I

                          Comment


                          • #14
                            Hi Tim,

                            That seems to be the case. try commenting out more statements in that area to see what happens..

                            Then try tweaking things in Matrix() and DRAWCIRCLE() !
                            Rgds, Dave

                            Comment


                            • #15
                              Tim

                              I keep saying OpenGL is probably the best way to do it.
                              One easy solution could be to convert a 2D drawing (with just the contours) into 3D coordinates.

                              See the Pix3D project here (that turns each pixel into 3d coordinates based on pixel color):
                              http://www.jose.it-berater.org/smffo...p?topic=5026.0
                              Patrice Terrier
                              www.zapsolution.com
                              www.objreader.com
                              Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).

                              Comment


                              • #16
                                Thanks to both of you Dave and Patrice

                                Comment

                                Working...
                                X