home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Bezier.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-23  |  13.1 KB  |  440 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBezier 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Bezier"
  6.    ClientHeight    =   5310
  7.    ClientLeft      =   300
  8.    ClientTop       =   555
  9.    ClientWidth     =   9150
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   5310
  24.    ScaleWidth      =   9150
  25.    Begin VB.CheckBox chkShowControlPoints 
  26.       Caption         =   "Show Control Points"
  27.       Height          =   255
  28.       Left            =   0
  29.       TabIndex        =   11
  30.       Top             =   0
  31.       Width           =   2055
  32.    End
  33.    Begin VB.OptionButton optSurface 
  34.       Caption         =   "Spiral"
  35.       Height          =   255
  36.       Index           =   7
  37.       Left            =   0
  38.       TabIndex        =   10
  39.       Top             =   3480
  40.       Width           =   2055
  41.    End
  42.    Begin VB.OptionButton optSurface 
  43.       Caption         =   "Twist"
  44.       Height          =   255
  45.       Index           =   6
  46.       Left            =   0
  47.       TabIndex        =   9
  48.       Top             =   3120
  49.       Width           =   2055
  50.    End
  51.    Begin VB.OptionButton optSurface 
  52.       Caption         =   "Cowling"
  53.       Height          =   255
  54.       Index           =   5
  55.       Left            =   0
  56.       TabIndex        =   8
  57.       Top             =   2760
  58.       Width           =   2055
  59.    End
  60.    Begin VB.OptionButton optSurface 
  61.       Caption         =   "Pipe"
  62.       Height          =   255
  63.       Index           =   4
  64.       Left            =   0
  65.       TabIndex        =   7
  66.       Top             =   2400
  67.       Width           =   2055
  68.    End
  69.    Begin VB.OptionButton optSurface 
  70.       Caption         =   "Curl"
  71.       Height          =   255
  72.       Index           =   3
  73.       Left            =   0
  74.       TabIndex        =   6
  75.       Top             =   2040
  76.       Width           =   2055
  77.    End
  78.    Begin VB.OptionButton optSurface 
  79.       Caption         =   "Wave"
  80.       Height          =   255
  81.       Index           =   1
  82.       Left            =   0
  83.       TabIndex        =   5
  84.       Top             =   1320
  85.       Width           =   2055
  86.    End
  87.    Begin VB.OptionButton optSurface 
  88.       Caption         =   "Hill"
  89.       Height          =   255
  90.       Index           =   0
  91.       Left            =   0
  92.       TabIndex        =   4
  93.       Top             =   960
  94.       Width           =   2055
  95.    End
  96.    Begin VB.CheckBox chkShowControlGrid 
  97.       Caption         =   "Show Control Grid"
  98.       Height          =   255
  99.       Left            =   0
  100.       TabIndex        =   3
  101.       Top             =   360
  102.       Width           =   2055
  103.    End
  104.    Begin VB.OptionButton optSurface 
  105.       Caption         =   "Tent"
  106.       Height          =   255
  107.       Index           =   2
  108.       Left            =   0
  109.       TabIndex        =   2
  110.       Top             =   1680
  111.       Width           =   2055
  112.    End
  113.    Begin VB.OptionButton optSurface 
  114.       Caption         =   "Urn"
  115.       Height          =   255
  116.       Index           =   8
  117.       Left            =   0
  118.       TabIndex        =   1
  119.       Top             =   3840
  120.       Width           =   2055
  121.    End
  122.    Begin VB.PictureBox picCanvas 
  123.       AutoRedraw      =   -1  'True
  124.       Height          =   5295
  125.       Left            =   2160
  126.       ScaleHeight     =   349
  127.       ScaleMode       =   3  'Pixel
  128.       ScaleWidth      =   461
  129.       TabIndex        =   0
  130.       Top             =   0
  131.       Width           =   6975
  132.    End
  133. Attribute VB_Name = "frmBezier"
  134. Attribute VB_GlobalNameSpace = False
  135. Attribute VB_Creatable = False
  136. Attribute VB_PredeclaredId = True
  137. Attribute VB_Exposed = False
  138. Option Explicit
  139. ' Location of viewing eye.
  140. Private EyeR As Single
  141. Private EyeTheta As Single
  142. Private EyePhi As Single
  143. Private Const Dtheta = PI / 20
  144. Private Const Dphi = PI / 20
  145. Private Const Dr = 1
  146. ' Location of focus point.
  147. Private Const FocusX = 0#
  148. Private Const FocusY = 0#
  149. Private Const FocusZ = 0#
  150. Private Projector(1 To 4, 1 To 4) As Single
  151. Private TheSurface As Bezier3d
  152. Private ShowingParameters As Boolean
  153. Private SurfaceSelected As Integer
  154. ' Display the surface.
  155. Private Sub DrawData(pic As Object)
  156. Dim S(1 To 4, 1 To 4) As Single
  157. Dim T(1 To 4, 1 To 4) As Single
  158. Dim ST(1 To 4, 1 To 4) As Single
  159. Dim PST(1 To 4, 1 To 4) As Single
  160.     MousePointer = vbHourglass
  161.     Refresh
  162.     ' Scale and translate so it looks OK in pixels.
  163.     m3Scale S, 35, -35, 1
  164.     m3Translate T, 230, 175, 0
  165.     m3MatMultiplyFull ST, S, T
  166.     m3MatMultiplyFull PST, Projector, ST
  167.     ' Transform the points.
  168.     TheSurface.ApplyFull PST
  169.     ' Prevent overflow errors when drawing lines
  170.     ' too far out of bounds.
  171.     On Error Resume Next
  172.     ' Display the data.
  173.     pic.Cls
  174.     TheSurface.Draw pic, EyeR
  175.     picCanvas.SetFocus
  176.     MousePointer = vbDefault
  177. End Sub
  178. ' Set the control points for an urn.
  179. Private Sub MakeUrn()
  180. Dim R(1 To 5) As Single
  181. Dim h(1 To 5) As Single
  182. Dim i As Integer
  183.     TheSurface.SetBounds 5, 6
  184.     R(1) = 1
  185.     R(2) = 1
  186.     R(3) = 5
  187.     R(4) = 1.5
  188.     R(5) = 1.5
  189.     h(1) = 4
  190.     h(2) = 3.5
  191.     h(3) = 2
  192.     h(4) = -1
  193.     h(5) = -3
  194.     For i = 1 To 5
  195.         TheSurface.SetControlPoint i, 1, -R(i), h(i), 0
  196.         TheSurface.SetControlPoint i, 2, -R(i), h(i), -1.5 * R(i)
  197.         TheSurface.SetControlPoint i, 3, 2 * R(i), h(i), -1.5 * R(i)
  198.         TheSurface.SetControlPoint i, 4, 2 * R(i), h(i), 1.5 * R(i)
  199.         TheSurface.SetControlPoint i, 5, -R(i), h(i), 1.5 * R(i)
  200.         TheSurface.SetControlPoint i, 6, -R(i), h(i), 0
  201.     Next i
  202. End Sub
  203. ' Set the control points for a pipe.
  204. Private Sub MakePipe()
  205. Const S = 3
  206. Dim i As Integer
  207. Dim X As Single
  208.     TheSurface.SetBounds 4, 6
  209.     For i = 1 To 4
  210.         X = 1.5 * (i - 2.5)
  211.         TheSurface.SetControlPoint i, 1, X, _
  212.             -S, 0
  213.         TheSurface.SetControlPoint i, 2, X, _
  214.             -S, -S
  215.         TheSurface.SetControlPoint i, 3, X, _
  216.             S, -S
  217.         TheSurface.SetControlPoint i, 4, X, _
  218.             S, S
  219.         TheSurface.SetControlPoint i, 5, X, _
  220.             -S, S
  221.         TheSurface.SetControlPoint i, 6, X, _
  222.             -S, 0
  223.     Next i
  224. End Sub
  225. ' Set the control points for a curl.
  226. Private Sub MakeCurl()
  227. Dim ang As Integer
  228. Dim j As Integer
  229. Dim R As Single
  230. Dim X As Single
  231. Dim Y As Single
  232. Dim Z As Single
  233.     TheSurface.SetBounds 4, 4
  234.     For j = 1 To 4
  235.         Z = 1.5 * (j - 2.5)
  236.         R = 6 - Abs(2 * j - 5)
  237.         For ang = 1 To 4
  238.             X = R * Cos((ang - 1) * PI / 2)
  239.             Y = R * Sin((ang - 1) * PI / 2)
  240.             TheSurface.SetControlPoint ang, j, X, Y, Z
  241.         Next ang
  242.     Next j
  243. End Sub
  244. ' Set the control points for a wave.
  245. Private Sub MakeWave()
  246. Dim i As Integer
  247. Dim j As Integer
  248.     TheSurface.SetBounds 4, 4
  249.     ' Start flat and modify from there.
  250.     For i = 1 To 4
  251.         For j = 1 To 4
  252.             TheSurface.SetControlPoint i, j, 2 * i - 5, 0, 2 * j - 5
  253.         Next j
  254.     Next i
  255.     ' Make the modifications.
  256.     TheSurface.SetControlPoint 2, 2, -1, -10, -1
  257.     TheSurface.SetControlPoint 2, 3, -1, 10, 1
  258.     TheSurface.SetControlPoint 3, 2, 1, -10, -1
  259.     TheSurface.SetControlPoint 3, 3, 1, 10, 1
  260. End Sub
  261. ' Set the control points for a tent.
  262. Private Sub MakeTent()
  263.     TheSurface.SetBounds 3, 3
  264.     TheSurface.SetControlPoint 1, 1, -3, -2, -3
  265.     TheSurface.SetControlPoint 1, 2, -3, 2, 0
  266.     TheSurface.SetControlPoint 1, 3, -3, -2, 3
  267.     TheSurface.SetControlPoint 2, 1, 0, 2, -3
  268.     TheSurface.SetControlPoint 2, 2, 0, 4, 0
  269.     TheSurface.SetControlPoint 2, 3, 0, 2, 3
  270.     TheSurface.SetControlPoint 3, 1, 3, -2, -3
  271.     TheSurface.SetControlPoint 3, 2, 3, 2, 0
  272.     TheSurface.SetControlPoint 3, 3, 3, -2, 3
  273. End Sub
  274. ' Set the control points for a spiral.
  275. Private Sub MakeSpiral()
  276.     TheSurface.SetBounds 5, 2
  277.     TheSurface.SetControlPoint 1, 1, -4, 2, 0
  278.     TheSurface.SetControlPoint 1, 2, -4, -2, 0
  279.     TheSurface.SetControlPoint 2, 1, -2, 0, -4
  280.     TheSurface.SetControlPoint 2, 2, -2, 0, 4
  281.     TheSurface.SetControlPoint 3, 1, 0, -6, 0
  282.     TheSurface.SetControlPoint 3, 2, 0, 6, 0
  283.     TheSurface.SetControlPoint 4, 1, 2, 0, 4
  284.     TheSurface.SetControlPoint 4, 2, 2, 0, -4
  285.     TheSurface.SetControlPoint 5, 1, 4, 2, 0
  286.     TheSurface.SetControlPoint 5, 2, 4, -2, 0
  287. End Sub
  288. ' Set the control points for a twist.
  289. Private Sub MakeTwist()
  290.     TheSurface.SetBounds 2, 2
  291.     TheSurface.SetControlPoint 1, 1, -2, 3, 3
  292.     TheSurface.SetControlPoint 1, 2, -3, 3, -3
  293.     TheSurface.SetControlPoint 2, 1, 3, 4, -2
  294.     TheSurface.SetControlPoint 2, 2, 2, -3, 0
  295. End Sub
  296. ' Set the control points for a cowling.
  297. Private Sub MakeCowl()
  298. Dim i As Integer
  299. Dim S As Single
  300. Dim Y As Single
  301.     TheSurface.SetBounds 4, 6
  302.     For i = 1 To 4
  303.         Y = 3 - 2 * Abs(i - 2.5)
  304.         
  305.         S = 2 + i / 2
  306.         
  307.         TheSurface.SetControlPoint i, 1, _
  308.             1.25 * S - 1, Y, 0
  309.         TheSurface.SetControlPoint i, 2, _
  310.             1.25 * S - 1, Y, S
  311.         TheSurface.SetControlPoint i, 3, _
  312.             -S - 1, Y, S
  313.         TheSurface.SetControlPoint i, 4, _
  314.             -S - 1, Y, -S
  315.         TheSurface.SetControlPoint i, 5, _
  316.             1.25 * S - 1, Y, -S
  317.         TheSurface.SetControlPoint i, 6, _
  318.             1.25 * S - 1, Y, 0
  319.     Next i
  320. End Sub
  321. ' Set the control points for a hill.
  322. Private Sub MakeHill()
  323. Dim i As Integer
  324. Dim j As Integer
  325.             
  326.     TheSurface.SetBounds 4, 4
  327.     ' Start flat and modify from there.
  328.     For i = 1 To 4
  329.         For j = 1 To 4
  330.             TheSurface.SetControlPoint i, j, 2 * i - 5, 0, 2 * j - 5
  331.         Next j
  332.     Next i
  333.     ' Make the modifications.
  334.     TheSurface.SetControlPoint 2, 2, -1, 7, -1
  335.     TheSurface.SetControlPoint 2, 3, -1, 7, 1
  336.     TheSurface.SetControlPoint 3, 2, 1, 7, -1
  337.     TheSurface.SetControlPoint 3, 3, 1, 7, 1
  338. End Sub
  339. Private Sub Form_Resize()
  340. Dim wid As Single
  341.     wid = ScaleWidth - picCanvas.Left
  342.     If wid < 120 Then wid = 120
  343.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  344. End Sub
  345. Private Sub optSurface_Click(Index As Integer)
  346.     SurfaceSelected = Index
  347.     CreateData
  348.     DrawData picCanvas
  349. End Sub
  350. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  351.     Select Case KeyCode
  352.         Case vbKeyLeft
  353.             EyeTheta = EyeTheta - Dtheta
  354.         Case vbKeyRight
  355.             EyeTheta = EyeTheta + Dtheta
  356.         Case vbKeyUp
  357.             EyePhi = EyePhi - Dphi
  358.         Case vbKeyDown
  359.             EyePhi = EyePhi + Dphi
  360.         Case Else
  361.             Exit Sub
  362.     End Select
  363.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  364.     DrawData picCanvas
  365. End Sub
  366. Private Sub Form_KeyPress(KeyAscii As Integer)
  367.     Select Case KeyAscii
  368.         Case Asc("+")
  369.             EyeR = EyeR + Dr
  370.         
  371.         Case Asc("-")
  372.             EyeR = EyeR - Dr
  373.         
  374.         Case Else
  375.             Exit Sub
  376.     End Select
  377.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  378.     DrawData picCanvas
  379. End Sub
  380. Private Sub Form_Load()
  381.     ' Initialize the eye position.
  382.     EyeR = 10
  383.     EyeTheta = PI * 0.2
  384.     EyePhi = PI * 0.1
  385.     ' Initialize the projection transformation.
  386.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  387. End Sub
  388. ' Create the surface.
  389. Private Sub CreateData()
  390. Const GapU = 0.1
  391. Const GapV = 0.1
  392. Const Du = GapU / 5
  393. Const Dv = GapV / 5
  394.     MousePointer = vbHourglass
  395.     Refresh
  396.     Set TheSurface = New Bezier3d
  397.     TheSurface.DrawControls = (chkShowControlPoints.value = vbChecked)
  398.     TheSurface.DrawGrid = (chkShowControlGrid.value = vbChecked)
  399.     ' Set the control points.
  400.     Select Case SurfaceSelected
  401.         Case 0  ' Hill.
  402.             MakeHill
  403.         Case 1  ' Wave.
  404.             MakeWave
  405.         Case 2  ' Tent.
  406.             MakeTent
  407.             
  408.         Case 3  ' Curl.
  409.             MakeCurl
  410.             
  411.         Case 4  ' Pipe.
  412.             MakePipe
  413.             
  414.         Case 5  ' Cowling.
  415.             MakeCowl
  416.             
  417.         Case 6  ' Twist.
  418.             MakeTwist
  419.         
  420.         Case 7  ' Spiral.
  421.             MakeSpiral
  422.         
  423.         Case 8  ' Urn.
  424.             MakeUrn
  425.         
  426.         Case Else  ' Something safe.
  427.             MakeHill
  428.     End Select
  429.     ' Initialize the Bezier surface.
  430.     TheSurface.InitializeGrid GapU, GapV, Du, Dv
  431. End Sub
  432. Private Sub chkShowControlPoints_Click()
  433.     TheSurface.DrawControls = (chkShowControlPoints.value = vbChecked)
  434.     DrawData picCanvas
  435. End Sub
  436. Private Sub chkshowcontrolgrid_Click()
  437.     TheSurface.DrawGrid = (chkShowControlGrid.value = vbChecked)
  438.     DrawData picCanvas
  439. End Sub
  440.