Announcement

Collapse

Forum Guidelines

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

Bézier surface

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

  • Bézier surface

    All code posted here is released to the Public Domain.
    Code:
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' BSurface.bas                    by Jordi Vallès      version 1g     16/09/2008
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    '  A Bézier surface is formed as the cartesian product of the blending functions
    '  of two orthogonal Bézier curves.
    '
    '  The theory about splines, patches and surfaces created from Bézier curves I
    '  have learned in Alan Watt book "3D Computer Graphics" 3rd edition, basically
    '  the 4 first chapters.
    '
    '  This sample shows one or two Bézier patches. Each patch is defined as a matrix
    '  of 4 x 4 points, and all operations are based over the points of this matrix.
    '
    '  Best explanation about Bézier Surfaces is in:
    '  Bézier Surfaces
    '  and Links referenced in this page, specially the written by Paul Bourke.
    '
    '  Some routines are adapted to PB from ones of P. Bourke, D. H. Frost and
    '  others, mainly from educational sites.
    '
    '  Trackbars are created with PB Graphics. Code adapted from models provided by
    '  Raffaello Bervini.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  - All code posted here is released to the Public Domain.
    '  - Program developed and tested with PowerBASIC for Windows (PB/Win 8.04) on
    '    PC HP Pavilion m7760 1.80 GHz with Windows Vista Home Premium.
    '  - Only PB Graphic package is used to draw information generated by program.
    '  - Four Graphic windows are created and attached in this program.
    '  - 16/09/2008 Recompiled and tested with PB/Win 9.0 without problems.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' To be solved:
    '  - Continuity across the two patches.
    '  - Some irregular behaviour on axis rotation.
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    ' SED_PBWIN
    
    #Compile Exe "BSurface.exe"
    #Dim All
    
    #Include "Win32Api.inc"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %ID_GRAPHIC    = 1100
    %ID_DRAWCP     = 1111
    %ID_DRAWGR     = 1112
    %ID_DRAWSH     = 1113
    %ID_RESET      = 1114
    %ID_EXIT       = 1115
    %ID_PATCH1     = 1116
    %ID_PATCH2     = 1117
    %ID_INFO1      = 1118
    %ID_INFO2      = 1119
    
    %ID_XSTP       = 3001      'my controls starts always on 3000
    %ID_YSTP       = 3002
    %ID_ZSTP       = 3003
    
    %LTRED         = &h5555FF???
    %SLIDER        = &hEEFAFA???
    %CANVAS        = &h400000???
    $TITLE         = "Bèzier surface  -  1g"
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Macro Pi       =  3.141592653589793#   'some comment?
    Macro Pi180    =  0.017453292519943#   'Pi/180
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Type POLYARRAY
       cnt As Long
       x1 As Single  :  y1 As Single
       x2 As Single  :  y2 As Single
       x3 As Single  :  y3 As Single
       x4 As Single  :  y4 As Single
    End Type
    
    Type JCONTROL
       handler  As Dword
       idc      As Long
       vtot     As Long
       divis    As Long
       txt      As String * 4
    End Type
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Global OldGraphicProc           As Dword        'old process, used in subclass
    Global hDlg, hGraphic           As Dword
    Global drawCP, drawGR, drawSH   As Long         'main switches for draw
    Global rl, rh                   As Long         'graphic space dimension
    Global X(), Y(), Z()            As Single       'control points or major nodes
    Global pX(), pY()               As Long         'projected control points
    Global bX(), bY(), bZ()         As Single       'compute patch vertices
    Global pbX(), pbY()             As Long         'projected patch vertices
    Global Trnf()                   As Single       'from 3D to 2D
    Global numPatches               As Long         'number of patches, 1 or 2
    Global steps, maxSteps, mouseSw As Long
    Global eyeX, eyeY, eyeZ         As Single       'used to pass from 3D to 2D
    Global factor                   As Single
    Global currentI, currentJ       As Long         'current cursor position on graphic space
    Global centerX, centerY         As Long         'start position of patch
    Global svX, svY, svZ            As Long
    Global jcount                   As Long
    Global jCtl()                   As JCONTROL
    
    Global mu00, mu01, mu02, mu10, mu11, mu12, mu20, mu21, mu22 As Single
    Global sv00, sv01, sv02, sv10, sv11, sv12, sv20, sv21, sv22 As Single
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Declare Function ComputeNodePoints(u As Single, v As Single, P() As Single, n As Long) As Single
    Declare Function CreateTrackbarHControl(hWnd As Dword, id As Long, posx As Long, posy As Long, wide As Long, high As Long, _
                                            mn As Long, mx As Long, per As Long, divis As Long, txt As String) As Dword
    Declare Function TrackbarHControl(hWnd As Dword, id As Long, posmx As Long, wantMouse As Long) As Long
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function PBMain()
       Local signature As Asciiz * 90
    
      '--- only one instance of this program is allowed ---
       signature = $TITLE + $TITLE + $TITLE
       If CreateMutex(ByVal 0, 1, signature) Then
          If GetLastError = %ERROR_ALREADY_EXISTS Then Exit Function
       End If
    
       Call InitialParms
    
       Dialog New Pixels, 0, $TITLE, , , 506, 604, %WS_CAPTION OR %WS_SYSMENU To hDlg
    
       Control Add Graphic,  hDlg, %ID_GRAPHIC,"", 3, 3, 500, 500, %SS_NOTIFY
       Control Get Client    hDlg, %ID_GRAPHIC To rl, rh    'get client (canvas) size
       Graphic Scale (0, 0) - (rl, rh)                      'scale to pixel coordinate system
    
       Control Add Button,   hDlg, %ID_RESET,   "Reset",                 436, 546,  66,  26
       Control Add Button,   hDlg, %ID_EXIT,    "Quit",                  436, 574,  66,  26
    
       Control Add Option,   hDlg, %ID_PATCH1,  "One Patch",             288, 506, 100,  16, %WS_GROUP
       Control Add Option,   hDlg, %ID_PATCH2,  "Two Patches",           288, 522, 100,  16
       Control Add CheckBox, hDlg, %ID_DRAWCP,  "Draw Control Points",   288, 546, 138,  16
       Control Add CheckBox, hDlg, %ID_DRAWGR,  "Draw Grid Detail",      288, 565, 138,  16
       Control Add CheckBox, hDlg, %ID_DRAWSH,  "Draw Gradient Shade",   288, 584, 138,  16
    
       Control Set Option    hDlg, %ID_PATCH1, %ID_PATCH1, %ID_PATCH2
    
       Control Add Label,    hDlg, %ID_INFO1,   "Pos:",                   20, 504,  80,  14
       Control Add Label,    hDlg, %ID_INFO2,   "",                      150, 504, 120,  14
    
       Control Set Check     hDlg, %ID_DRAWCP, 1
       Control Set Check     hDlg, %ID_DRAWGR, 0
       Control Disable       hDlg, %ID_DRAWSH
    
       '--- tracbars creation ---
       CreateTrackbarHControl(hDlg, %ID_XSTP,  4, 522, 260, 20, -100, 100, 0, 20, "X = ")
       CreateTrackbarHControl(hDlg, %ID_YSTP,  4, 550, 260, 20, -100, 100, 0, 20, "Y = ")
       CreateTrackbarHControl(hDlg, %ID_ZSTP,  4, 578, 260, 20, -100, 100, 0, 20, "Z = ")
    
       '--- main graphic activation ---
       Graphic Attach hDlg, %ID_GRAPHIC, Redraw                          'ATTACH
       Graphic Color %WHITE, %CANVAS
    
       Graphic Box (0, 0) - (rl, rh), 6, %WHITE, %CANVAS                 'my GRAPHIC CLEAR
    
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    CallBack Function DlgProc() As Long
       Local CtrlID As Long
    
       Select Case As Long CbMsg
          Case %WM_INITDIALOG
             Control Handle    CbHndl, %ID_GRAPHIC To hGraphic
             OldGraphicProc = SetWindowLong(hGraphic, %GWL_WNDPROC, CodePtr(GraphicProc))
             Control Get Check CbHndl, %ID_DRAWCP To drawCP
             Control Get Check CbHndl, %ID_DRAWGR To drawGR
             Sleep 100
             TrackbarHControl  CbHndl, %ID_XSTP, 30, %FALSE
             TrackbarHControl  CbHndl, %ID_YSTP,  0, %FALSE
             TrackbarHControl  CbHndl, %ID_ZSTP,  0, %FALSE
             Sleep 100
             Call InitControlPoints
             Call RotateAxisX(30)
             Call PaintPatch(%TRUE)
    
          Case %WM_SETCURSOR
             If CbWParam <> hGraphic Then
                Control Set Text CbHndl, %ID_INFO1, "Pos:"
                CtrlID = GetDlgCtrlID(CbWParam) : GetAsyncKeyState(%VK_LBUTTON)
                Select Case CtrlID
                   Case %ID_XSTP To %ID_ZSTP
                      If GetAsyncKeyState(%VK_LBUTTON) <> 0 Then
                         Select Case CtrlId
                            Case %ID_XSTP
                               Call RotateAxisX(-svX)
                               Call RotateAxisX(TrackbarHControl(CbHndl, CtrlID, 0, %TRUE))
                            Case %ID_YSTP
                               Call RotateAxisY(-svY)
                               Call RotateAxisY(TrackbarHControl(CbHndl, CtrlID, 0, %TRUE))
                            Case %ID_ZSTP
                               Call RotateAxisZ(-svZ)
                               Call RotateAxisZ(TrackbarHControl(CbHndl, CtrlID, 0, %TRUE))
                         End Select
                      End If
                      Call PaintPatch(%TRUE)
                End Select
             End If
    
          Case %WM_COMMAND
             If CbCtlMsg <> %BN_CLICKED Then Exit Select
             Select Case CbCtl
                Case %ID_PATCH1
                   numPatches = 1
                   Control Send CbHndl, %ID_RESET, %BM_CLICK, 0, 0
                Case %ID_PATCH2
                   numPatches = 2
                   Control Send CbHndl, %ID_RESET, %BM_CLICK, 0, 0
                Case %ID_DRAWCP
                   Control Get Check CbHndl, %ID_DRAWCP To drawCP
                   Call PaintPatch(%TRUE)
                Case %ID_DRAWGR
                   Control Get Check CbHndl, %ID_DRAWGR To drawGR
                   If drawGR Then
                      Control Enable hDlg, %ID_DRAWSH
                   Else
                      Control Disable hDlg, %ID_DRAWSH
                   End If
                   Call PaintPatch(%TRUE)
                Case %ID_DRAWSH
                   Control Get Check CbHndl, %ID_DRAWSH To drawSH
                   Call PaintPatch(%TRUE)
                Case %IDCANCEL, %ID_EXIT
                   Dialog End CbHndl, 0
                   Function = 1 : Exit Function
                Case %ID_RESET
                   Control Set Check CbHndl, %ID_DRAWCP, 1  :  drawCP = 1
                   Control Set Check CbHndl, %ID_DRAWGR, 0  :  drawGR = 0
                   Control Set Check CbHndl, %ID_DRAWSH, 0  :  drawSH = 0
                   Call InitControlPoints
                   Call RotateAxisX(30)
                   Call PaintPatch(%TRUE)
                   TrackbarHControl CbHndl, %ID_XSTP, 30, %FALSE
                   TrackbarHControl CbHndl, %ID_YSTP,  0, %FALSE
                   TrackbarHControl CbHndl, %ID_ZSTP,  0, %FALSE
             End Select
    
          Case %WM_SYSCOMMAND
             If CbWParam = %SC_CLOSE Then
                Dialog End CbHndl, 0
                Function = 1
                Exit Function
             End If
    
          Case %WM_NCACTIVATE
             Static hWndsvFocus As Dword
             If IsFalse CbWParam Then
                hWndsvFocus = GetFocus()
             ElseIf hWndsvFocus Then
                SetFocus(hWndsvFocus)
                hWndsvFocus = 0
             End If
    
          Case %WM_DESTROY
             If OldGraphicProc Then SetWindowLong hGraphic, %GWL_WNDPROC, OldGraphicProc
       End Select
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function GraphicProc(Byval hWnd As Dword, Byval wMsg As Dword, Byval wParam As Dword, Byval lParam As Long) As Long
       Select Case wMsg
          Case %WM_LBUTTONDOWN  :  Call LeftButtonDown (hWnd, wParam, lParam)
          Case %WM_MOUSEMOVE    :  Call MouseMove      (hWnd, wParam, lParam)
          Case %WM_LBUTTONUP    :  Call LeftButtonUp   (hWnd, wParam, lParam)
       End Select
       Function = CallWindowProc(OldGraphicProc, hWnd, wMsg, wParam, lParam)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub LeftButtonDown(Byval hWnd As Dword, Byval wParam As Dword, Byval lParam As Long)
       Register i As Long, j As Long, t AS Long
       Local pt As POINTAPI
    
       GetCursorPos pt
       ScreenToClient hWnd, pt
       mouseSw = %TRUE
    
       'look for a match
       For t = 0 To 3
          For i = 0 To numPatches*3
             For j = 0 To 3
                If ((pt.x-t <= pX(i,j)) And (pX(i,j) <= pt.x+t) And (pt.y-t <= pY(i,j)) And (pY(i,j) <= pt.y+t)) Then
                   currentI = i  :  currentJ = j
                   Control Set Text hDlg, %ID_INFO2, "Node" + Str$(i) + Str$(j) + " caught"
                   Sleep 1
                   Exit Sub
                End If
             Next j
          Next i
       Next k
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub LeftButtonUp(Byval hWnd As Dword, Byval wParam As Dword, Byval lParam As Long)
       currentI = -1
       Call PaintPatch(%TRUE)
       Control Set Text hDlg, %ID_INFO2, Space$(20)
       Control Set Text hDlg, %ID_INFO1, "Pos:"
       mouseSw = %FALSE
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub MouseMove(Byval hWnd As Dword, Byval wParam As Dword, Byval lParam As Long)
       Local pt As POINTAPI
    
       If mouseSw Then Control Set Text hDlg, %ID_INFO1, "Pos:" + Str$(Lo(Integer, lParam)) + "," + Str$(Hi(Integer, lParam))
       If currentI = -1 Then Exit Sub
       GetCursorPos pt
       ScreenToClient hWnd, pt
    
        X(currentI,currentJ) = eyeX + ((pt.x-centerX) * (Z(currentI,currentJ)-eyeZ) / -factor)
       Y(currentI,currentJ) = eyeY + ((centerY-pt.y) * (Z(currentI,currentJ)-eyeZ) / -factor)
       Call PaintPatch(%TRUE)
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub PaintPatch(wantErase As Long)
       Register i As Long, j As Long, n As Long
       Local u, v, step1 As Single
       Local u1, v1 As Long
       Local poly As POLYARRAY
    
       Graphic Attach hDlg, %ID_GRAPHIC, Redraw        'get graphic control, ATTACH
    
       If wantErase Then Graphic Box (0, 0) - (rl, rh), 6, %WHITE, %CANVAS      'my GRAPHIC CLEAR
    
       Call DrawControlPoints
    
       If currentI = -1 Then
          For n = 0 to numPatches-1
             step1 = 1.0 / steps
             u1 = 0  :  v1 = 0
    
             'create space subdivisions from Control Points
             'the result is the green grid (4.2.2)
             For u = 0 To 1.0001 Step step1
                For v = 0 To 1.0001 Step step1
                   'compute node points
                   bX(u1,v1) = ComputeNodePoints(u, v, X(), n*3)
                   bY(u1,v1) = ComputeNodePoints(u, v, Y(), n*3)
                   bZ(u1,v1) = ComputeNodePoints(u, v, Z(), n*3)
                   Incr v1
                Next v
                v1 = 0
                Incr u1
             Next u
    
             'transform from 3D to 2D
             For i = 0 To steps
                For j = 0 To steps
                   Call Interpolation(bX(i,j), bY(i,j), bZ(i,j))
                   pbX(i,j) = ((Trnf(0)-eyeX) / (Trnf(2)-eyeZ) * -factor + 0.5) + centerX
                   pbY(i,j) = centerY - ((Trnf(1)-eyeY) / (Trnf(2)-eyeZ) * -factor + 0.5)
                Next j
             Next i
    
             'draw wireframe, if selected
             If drawGR Then
                For i = 0 to steps
                   For j = 0 To steps
                      If i < steps Then
                         Graphic Line (pbX(i,j), pbY(i,j)) - (pbX(i+1,j), pbY(i+1,j)), %GREEN
                      End If
                      If j < steps Then
                         Graphic Line (pbX(i,j), pbY(i,j)) - (pbX(i,j+1), pbY(i,j+1)), %GREEN
                      End If
                   Next j
                Next i
    
                'draw gradient shade, if selected
                'needs drawGR switch on (wireframe)
                If drawSH Then
                   poly.cnt = 4
                   For i = 0 to steps
                      For j = 0 To steps
                         If i < steps And j < steps Then
                            poly.x1 = pbX(i,j)     :  poly.y1 = pbY(i,j)
                            poly.x2 = pbX(i+1,j)   :  poly.y2 = pbY(i+1,j)
                            poly.x4 = pbX(i,j+1)   :  poly.y4 = pbY(i,j+1)
                            poly.x3 = pbX(i+1,j+1) :  poly.y3 = pbY(i+1,j+1)
                            u = 140 + bz(i,j)*10
                            Graphic Polygon poly, RGB(u/2,u,20), RGB(u/2,u,0)
                         End If
                      Next j
                   Next i
                End If
             End If
    
          Next n
       End If
       Graphic Redraw
    
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub DrawControlPoints()
       Register i As Long, j As Long
    
       If drawCP Then
          For i = 0 To numPatches * 3
             For j = 0 To 3
                'calculate control points positions
                'transform from 3D to 2D and after display it
                Call Interpolation(X(i,j), Y(i,j), Z(i,j))
                pX(i,j) = ((Trnf(0) - eyeX) / (Trnf(2) - eyeZ) * -factor + 0.5) + centerX
                pY(i,j) = centerY - ((Trnf(1) - eyeY) / (Trnf(2) - eyeZ) * -factor + 0.5)
             Next j
          Next i
          For i = 0 to numPatches * 3
             For j = 0 to 3
                If (i < numPatches*3) Then
                   Graphic Line (pX(i,j), pY(i,j)) - (pX(i+1,j), pY(i+1,j)), %GRAY
                End If
                If (j < 3) Then
                   Graphic Line (pX(i,j),   pY(i,j)) - (pX(i,j+1), pY(i,j+1)), %GRAY
                End If
                Graphic Box (pX(i,j)-2, pY(i,j)-2) - (pX(i,j)+2, pY(i,j)+2) , , -1, -1
             Next j
          Next i
       End If
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function ComputeNodePoints(u0 As Single, v0 As Single, P() As Single, n As Long) As Single
       'u0 and v0 must be values between 0 and 1
    
       'Calculate the heights of Control Points of a Bézier patch using the Bernstein cubic
       'polynomials method, based on descriptions (3.1 and 3.4) of book referenced. Also
       'some samples and comments of Paul Bourke and Daniel H. Frost, help me a lot.
       'Not is the best but is faster.
    
       'This routine is called 1452 times per patch for each change on Control Point matrix,
       'just when the left button is released. See PaintPatch subroutine.
       '           1452 = 3 * 484 times for each axis
       '            484 = 22 * 22 steps to form the grid
    
       'To investigate: Cubic Bézier curve used in Postscript, developed by Adobe,
       '                according to some authors is the best and fast method.
    
       Local u1, v1, v1squared, v1cubed, v0squared, v0cubed As Single
    
       u1        = 1 - u0
       v1        = 1 - v0
       v1squared = v1*v1
       v1cubed   = v1*v1squared
       v0squared = v0*v0
       v0cubed   = v0*v0squared
    
       Function = _
          u1*u1*u1 * _
             (P(n+0,0) * v1cubed + 3*P(n+0,1) * v1squared * v0 + 3*P(n+0,2) * v1 * v0squared + P(n+0,3) * v0cubed) + _
          3*u1*u1*u0 * _
             (P(n+1,0) * v1cubed + 3*P(n+1,1) * v1squared * v0 + 3*P(n+1,2) * v1 * v0squared + P(n+1,3) * v0cubed) + _
          3*u1*u0*u0 * _
             (P(n+2,0) * v1cubed + 3*P(n+2,1) * v1squared * v0 + 3*P(n+2,2) * v1 * v0squared + P(n+2,3) * v0cubed) + _
          u0*u0*u0 * _
             (P(n+3,0) * v1cubed + 3*P(n+3,1) * v1squared * v0 + 3*P(n+3,2) * v1 * v0squared + P(n+3,3) * v0cubed)
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub InitialParms()
       numPatches = 1
       centerX = 250  :  centerY = 200
       maxSteps = 50
       currentI = -1    '-1 means no control point is current
    
       Redim X(0 To 6, 0 To 3) As Single
       Redim Y(0 To 6, 0 To 3) As Single
       Redim Z(0 To 6, 0 To 3) As Single
       Redim pX(0 To 6, 0 To 3) As Long
       Redim pY(0 To 6, 0 To 3) As Long
       Redim Trnf(0 to 2) As Single
       Redim bx(0 To maxSteps, 0 To maxSteps)
       Redim by(0 To maxSteps, 0 To maxSteps)
       Redim bz(0 To maxSteps, 0 To maxSteps)
       Redim pbx(0 To maxSteps, 0 To maxSteps)
       Redim pby(0 To maxSteps, 0 To maxSteps)
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub InitControlPoints()
       Register j As Long, i As Long
    
       steps      = 21
       factor     = 600
       eyeX = 0  :  eyeY = 5  :  eyeZ = 50
    
       'set mu ranges
       mu00 = 1.0  :  mu11 = 1.0  :  mu22 = 1.0
       mu01 = 0.0  :  mu02 = 0.0  :  mu10 = 0.0
       mu12 = 0.0  :  mu20 = 0.0  :  mu21 = 0.0
    
       'control points initial values
       X(0,0) = -30  :  Y(0,0) = 0  :  Z(0,0) =   15
       X(0,1) = -30  :  Y(0,1) = 0  :  Z(0,1) =    5
       X(0,2) = -30  :  Y(0,2) = 0  :  Z(0,2) =   -5
       X(0,3) = -30  :  Y(0,3) = 0  :  Z(0,3) =  -15
       X(1,0) = -20  :  Y(1,0) = 0  :  Z(1,0) =   15
       X(1,1) = -20  :  Y(1,1) = 0  :  Z(1,1) =    5
       X(1,2) = -20  :  Y(1,2) = 0  :  Z(1,2) =   -5
       X(1,3) = -20  :  Y(1,3) = 0  :  Z(1,3) =  -15
       X(2,0) = -10  :  Y(2,0) = 0  :  Z(2,0) =   15
       X(2,1) = -10  :  Y(2,1) = 0  :  Z(2,1) =    5
       X(2,2) = -10  :  Y(2,2) = 0  :  Z(2,2) =   -5
       X(2,3) = -10  :  Y(2,3) = 0  :  Z(2,3) =  -15
       X(3,0) =   0  :  Y(3,0) = 0  :  Z(3,0) =   15
       X(3,1) =   0  :  Y(3,1) = 0  :  Z(3,1) =    5
       X(3,2) =   0  :  Y(3,2) = 0  :  Z(3,2) =   -5
       X(3,3) =   0  :  Y(3,3) = 0  :  Z(3,3) =  -15
       X(4,0) =  10  :  Y(4,0) = 0  :  Z(4,0) =   15
       X(4,1) =  10  :  Y(4,1) = 0  :  Z(4,1) =    5
       X(4,2) =  10  :  Y(4,2) = 0  :  Z(4,2) =   -5
       X(4,3) =  10  :  Y(4,3) = 0  :  Z(4,3) =  -15
       X(5,0) =  20  :  Y(5,0) = 0  :  Z(5,0) =   15
       X(5,1) =  20  :  Y(5,1) = 0  :  Z(5,1) =    5
       X(5,2) =  20  :  Y(5,2) = 0  :  Z(5,2) =   -5
       X(5,3) =  20  :  Y(5,3) = 0  :  Z(5,3) =  -15
       X(6,0) =  30  :  Y(6,0) = 0  :  Z(6,0) =   15
       X(6,1) =  30  :  Y(6,1) = 0  :  Z(6,1) =    5
       X(6,2) =  30  :  Y(6,2) = 0  :  Z(6,2) =   -5
       X(6,3) =  30  :  Y(6,3) = 0  :  Z(6,3) =  -15
    
       If numPatches = 1 Then   'if only 1 patch the first half is needed must be centered
          For i = 0 to 3
             For j = 0 to 3
                X(i,j) = X(i,j) +15
             Next j
          Next i
       End If
    
       For i = 0 to 6           'if only 1 patch only the half is useful
          For j = 0 to 3
             X(i,j) = X(i,j) / 2
             Z(i,j) = Z(i,j) / 2
          Next j
       Next i
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub Interpolation(xx As Single, yy As Single, zz As Single)
       'three control point Bezier interpolation
        'mu ranges from 0 to 1, start to end of the curve
       'adapted from Paul Bourke
       Trnf(0) = xx * mu00 + yy * mu10 + zz * mu20
       Trnf(1) = xx * mu01 + yy * mu11 + zz * mu21
       Trnf(2) = xx * mu02 + yy * mu12 + zz * mu22
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub RotateAxisX(degrees As Long)
       Local radians, cn, sn As Single
       svX = degrees
       radians = degrees * Pi180
       sn = Sin(radians)
       cn = Cos(radians)
       Call MuCopyToSave
       mu01 = sv01 * cn + sv02 * -sn
       mu02 = sv01 * sn + sv02 *  cn
       mu11 = sv11 * cn + sv12 * -sn
       mu12 = sv11 * sn + sv12 *  cn
       mu21 = sv21 * cn + sv22 * -sn
       mu22 = sv21 * sn + sv22 *  cn
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub RotateAxisY(degrees As Long)
       Local radians, cn, sn As Single
       svY = degrees
       radians = degrees * Pi180
       sn = Sin(radians)
       cn = Cos(radians)
       Call MuCopyToSave
       mu00 = sv00 *  cn + sv02 * sn
       mu02 = sv00 * -sn + sv02 * cn
       mu10 = sv10 *  cn + sv12 * sn
       mu12 = sv10 * -sn + sv12 * cn
       mu20 = sv20 *  cn + sv22 * sn
       mu22 = sv20 * -sn + sv22 * cn
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub RotateAxisZ(degrees As Long)
       Local radians, cn, sn As Single
       svZ = degrees
       radians = degrees * Pi180
       sn = Sin(radians)
       cn = Cos(radians)
       Call MuCopyToSave
       mu00 = sv00 * cn + sv01 * -sn
       mu01 = sv00 * sn + sv01 *  cn
       mu10 = sv10 * cn + sv11 * -sn
       mu11 = sv10 * sn + sv11 *  cn
       mu20 = sv20 * cn + sv21 * -sn
       mu21 = sv20 * sn + sv21 *  cn
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Sub MuCopyToSave()
       sv00 = mu00  :  sv01 = mu01  :  sv02 = mu02
       sv10 = mu10  :  sv11 = mu11  :  sv12 = mu12
       sv20 = mu20  :  sv21 = mu21  :  sv22 = mu22
    End Sub
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function CreateTrackbarHControl(hWnd As Dword, id As Long, posx As Long, posy As Long, wide As Long, high As Long, _
                                 mn As Long, mx As Long, per As Long, divis As Long, txt As String) As Dword
       Local rll, rhh As Long
    
       Incr jcount
       Redim Preserve jCtl(1 To jcount) As JCONTROL
       jCtl(jcount).idc   = id -3000                          'my controls starts always on 3000
       jCtl(jcount).vtot  = Abs(mx-mn)                        'range
       jCtl(jcount).divis = divis                             'number of divisions
       jCtl(jcount).txt   = txt                               'text to display inside trackbar
       Control Add Graphic, hWnd, id, "", posx, posy, wide, high, %SS_NOTIFY
       Control Get Client   hWnd, id To rll, rhh              'get client (canvas) size
       Graphic Scale (0, 0) - (rll, rhh)                      'scale to pixel coordinate
       Graphic Attach hWnd, id, ReDraw                        'ATTACH
       Graphic Font "Verdana", 8, 0
       Graphic Width 3
       Graphic Box (0,0) - (wide, high), ,%GRAY, %SLIDER
       Graphic ReDraw
       Control Handle hWnd, id To jCtl(jcount).handler
    
       FUNCTION = jCtl(jcount).handler
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    Function TrackbarHControl(hWnd As Dword, id As Long, posmx As Long, wantMouse As Long) As Long
       Local pt As POINTAPI
       Local handler As Dword
       Local d As Single
       Local j, k, v, mx, my, wide, high, posx, posy, idc, sx, sy As Long
       Local txt As String
    
       idc = id -3000                                         'my controls starts always on 3000
       handler = jCtl(idc).handler                            'get appropriate trackbar handler
       v = jCtl(idc).vtot                                     'range to be covered by slider
    
       Graphic Attach handler, id, ReDraw                     'get graphic control, ATTACH
       Graphic Get Client To wide, high
       Control Get Loc jCtl(idc).handler, id To posx, posy
    
       If wantMouse Then                                      'mouse position requested?
          GetCursorPos pt
          ScreenToClient handler, pt
          mx = pt.x-posx  :  my = pt.y-posy
          Control Set Text hDlg, %ID_INFO1, "Pos:" + Str$(mx) + "," + Str$(my)
          txt = jCtl(idc).txt + Ltrim$(Str$(Round (Min(v, v*(pt.x-posx) / wide),0) -v/2))
          FUNCTION = Round(Min(v, v*(pt.x-posx) / wide),0) -v/2
       Else                                                   'position is passed as parameter
          d = wide / v
          mx = (wide/2) + (posmx*d)
          txt = jCtl(idc).txt + Ltrim$(Str$(posmx))
          FUNCTION = posmx
       End If
    
       Graphic Width 3                                            'draw frame and
       Graphic Box (0,0) - (wide, high), ,%GRAY, %SLIDER          'clear previous info
    
       Graphic Width 1
       Graphic Box (mx-7, posy+3) - (mx+8, posy+high-3), ,%GRAY   'slider box
       Graphic Line (mx, posy+3) - (mx, posy+high-3), %LTRED      'slider line
    
       Graphic Text Size txt To sx, sy                            'set text
       Graphic Set Pos (wide/2-sx/2, high/2-sy/2-2)               '
       Graphic Color %BLUE, -2                                    '
       Graphic Print txt                                          '
    
       If jCtl(idc).divis > 0 Then                                'divisions required?
          k = (wide-6) / jCtl(idc).divis
          For j = 1 To jCtl(idc).divis -1
             Graphic Line (posx+k*j, posy+high-6) - (posx+k*j, posy+high-2)
          Next j
       End If
    
       Graphic Redraw                                             'draw all
    End Function
    
    '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
    'eof
    Last edited by Jordi Vallès; 18 Sep 2008, 03:15 PM. Reason: Comment added about public domain.
Working...
X