home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch11 / Bezier2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-06-12  |  7.0 KB  |  236 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBezier2 
  3.    Caption         =   "Bezier2"
  4.    ClientHeight    =   5490
  5.    ClientLeft      =   2175
  6.    ClientTop       =   645
  7.    ClientWidth     =   4830
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   366
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   322
  13.    Begin VB.CommandButton cmdNew 
  14.       Caption         =   "New"
  15.       Enabled         =   0   'False
  16.       Height          =   375
  17.       Left            =   4320
  18.       TabIndex        =   5
  19.       Top             =   0
  20.       Width           =   495
  21.    End
  22.    Begin VB.CommandButton cmdGo 
  23.       Caption         =   "Go"
  24.       Default         =   -1  'True
  25.       Enabled         =   0   'False
  26.       Height          =   375
  27.       Left            =   3600
  28.       TabIndex        =   4
  29.       Top             =   0
  30.       Width           =   495
  31.    End
  32.    Begin VB.CheckBox chkControlPoints 
  33.       Caption         =   "Show Control Points"
  34.       Height          =   255
  35.       Left            =   1080
  36.       TabIndex        =   3
  37.       Top             =   60
  38.       Value           =   1  'Checked
  39.       Width           =   1815
  40.    End
  41.    Begin VB.TextBox txtDt 
  42.       Height          =   285
  43.       Left            =   240
  44.       TabIndex        =   2
  45.       Text            =   "0.01"
  46.       Top             =   45
  47.       Width           =   615
  48.    End
  49.    Begin VB.PictureBox picCanvas 
  50.       AutoRedraw      =   -1  'True
  51.       Height          =   4815
  52.       Left            =   0
  53.       ScaleHeight     =   317
  54.       ScaleMode       =   3  'Pixel
  55.       ScaleWidth      =   317
  56.       TabIndex        =   0
  57.       Top             =   480
  58.       Width           =   4815
  59.    End
  60.    Begin VB.Label Label1 
  61.       Caption         =   "dt"
  62.       Height          =   255
  63.       Index           =   1
  64.       Left            =   0
  65.       TabIndex        =   1
  66.       Top             =   60
  67.       Width           =   255
  68.    End
  69. Attribute VB_Name = "frmBezier2"
  70. Attribute VB_GlobalNameSpace = False
  71. Attribute VB_Creatable = False
  72. Attribute VB_PredeclaredId = True
  73. Attribute VB_Exposed = False
  74. Option Explicit
  75. Private Const GAP = 2
  76. ' The endpoints are points 1 and 4. The control
  77. ' points are points 2 and 3.
  78. Private MaxPt As Integer
  79. Private PtX() As Single
  80. Private PtY() As Single
  81. Private MakingNew As Boolean
  82. ' The index of the point being dragged.
  83. Private Dragging As Integer
  84. ' The blending function for i, N, and t.
  85. Private Function Blend(ByVal i As Integer, ByVal N As Integer, ByVal t As Single) As Single
  86.     Blend = Factorial(N) / Factorial(i) / _
  87.         Factorial(N - i) * t ^ i * (1 - t) ^ (N - i)
  88. End Function
  89. ' Draw the curve on the indicated picture box.
  90. Private Sub DrawCurve(ByVal pic As PictureBox, ByVal start_t As Single, ByVal stop_t As Single, ByVal dt As Single)
  91. Dim t As Single
  92.     pic.Cls
  93.     pic.CurrentX = X(start_t)
  94.     pic.CurrentY = Y(start_t)
  95.     t = start_t + dt
  96.     Do While t < stop_t
  97.         pic.Line -(X(t), Y(t))
  98.         t = t + dt
  99.     Loop
  100.     pic.Line -(X(stop_t), Y(stop_t))
  101. End Sub
  102. ' Return the factorial of a number.
  103. Private Function Factorial(ByVal N As Integer) As Long
  104. Dim value As Long
  105. Dim i As Integer
  106.     value = 1
  107.     For i = 2 To N
  108.         value = value * i
  109.     Next i
  110.     Factorial = value
  111. End Function
  112. ' The parametric function Y(t).
  113. Private Function Y(ByVal t As Single) As Single
  114. Dim i As Integer
  115. Dim value As Single
  116.     For i = 0 To MaxPt
  117.         value = value + PtY(i) * Blend(i, MaxPt, t)
  118.     Next i
  119.     Y = value
  120. End Function
  121. ' The parametric function X(t).
  122. Private Function X(ByVal t As Single) As Single
  123. Dim i As Integer
  124. Dim value As Single
  125.     For i = 0 To MaxPt
  126.         value = value + PtX(i) * Blend(i, MaxPt, t)
  127.     Next i
  128.     X = value
  129. End Function
  130. ' Use DrawCurve to draw the Bezier curve.
  131. Private Sub DrawBezier()
  132. Dim dt As Single
  133. Dim i As Integer
  134.     If MaxPt < 0 Then Exit Sub
  135.     dt = CSng(txtDt.Text)
  136.     DrawCurve picCanvas, 0, 1, dt
  137.     If chkControlPoints.value = vbChecked Then
  138.         ' Draw the control points.
  139.         For i = 0 To MaxPt
  140.             picCanvas.Line _
  141.                 (PtX(i) - GAP, PtY(i) - GAP)- _
  142.                 Step(2 * GAP, 2 * GAP), , BF
  143.         Next i
  144.         ' Connect the control points.
  145.         picCanvas.DrawStyle = vbDot
  146.         picCanvas.CurrentX = PtX(0)
  147.         picCanvas.CurrentY = PtY(0)
  148.         For i = 1 To MaxPt
  149.             picCanvas.Line -(PtX(i), PtY(i))
  150.         Next i
  151.         picCanvas.DrawStyle = vbSolid
  152.     End If
  153. End Sub
  154. ' Either collect a new point or select a point and
  155. ' start dragging it.
  156. Private Sub picCanvas_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
  157. Dim i As Integer
  158.     ' If we are selecting points, do so now.
  159.     If MakingNew Then
  160.         MaxPt = MaxPt + 1
  161.         ReDim Preserve PtX(0 To MaxPt)
  162.         ReDim Preserve PtY(0 To MaxPt)
  163.         PtX(MaxPt) = X
  164.         PtY(MaxPt) = Y
  165.         picCanvas.Line _
  166.             (X - GAP, Y - GAP)- _
  167.             Step(2 * GAP, 2 * GAP), , BF
  168.         
  169.         If MaxPt >= 3 Then cmdGo.Enabled = True
  170.         
  171.         Exit Sub
  172.     End If
  173.     ' Otherwise start dragging a point.
  174.     ' Find a close point.
  175.     For i = 0 To MaxPt
  176.         If Abs(PtX(i) - X) <= GAP And _
  177.            Abs(PtY(i) - Y) <= GAP Then Exit For
  178.     Next i
  179.     If i > MaxPt Then Exit Sub
  180.     Dragging = i
  181.     picCanvas.DrawMode = vbInvert
  182.     PtX(Dragging) = X
  183.     PtY(Dragging) = Y
  184.     picCanvas.Line _
  185.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  186.         Step(2 * GAP, 2 * GAP), , BF
  187. End Sub
  188. ' Continue dragging a point.
  189. Private Sub picCanvas_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
  190.     If Dragging < 0 Then Exit Sub
  191.     picCanvas.Line _
  192.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  193.         Step(2 * GAP, 2 * GAP), , BF
  194.     PtX(Dragging) = X
  195.     PtY(Dragging) = Y
  196.     picCanvas.Line _
  197.         (PtX(Dragging) - GAP, PtY(Dragging) - GAP)- _
  198.         Step(2 * GAP, 2 * GAP), , BF
  199. End Sub
  200. ' Finish the drag and redraw the curve.
  201. Private Sub picCanvas_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
  202.     If Dragging < 0 Then Exit Sub
  203.     picCanvas.DrawMode = vbCopyPen
  204.     PtX(Dragging) = X
  205.     PtY(Dragging) = Y
  206.     Dragging = -1
  207.     DrawBezier
  208. End Sub
  209. Private Sub CmdGo_Click()
  210.     MakingNew = False
  211.     cmdNew.Enabled = True
  212.     DrawBezier
  213. End Sub
  214. ' Prepare to get new points.
  215. Private Sub CmdNew_Click()
  216.     MaxPt = -1
  217.     cmdGo.Enabled = False
  218.     cmdNew.Enabled = False
  219.     MakingNew = True
  220.     picCanvas.Cls
  221. End Sub
  222. Private Sub chkControlPoints_Click()
  223.     DrawBezier
  224. End Sub
  225. Private Sub Form_Load()
  226.     MakingNew = True
  227.     MaxPt = -1
  228.     Dragging = -1
  229. End Sub
  230. ' Make the picCanvas as big as possible.
  231. Private Sub Form_Resize()
  232.     picCanvas.Move 0, picCanvas.Top, _
  233.         ScaleWidth, ScaleHeight - picCanvas.Top
  234.     DrawBezier
  235. End Sub
  236.