home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / TweenSmo.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-05-29  |  24.8 KB  |  803 lines

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmTweenSmo 
  4.    Caption         =   "TweenSmo"
  5.    ClientHeight    =   4590
  6.    ClientLeft      =   2040
  7.    ClientTop       =   1035
  8.    ClientWidth     =   4635
  9.    LinkTopic       =   "Form1"
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   306
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   309
  14.    Begin VB.CommandButton cmdTween 
  15.       Caption         =   "Tween"
  16.       Height          =   495
  17.       Left            =   3480
  18.       TabIndex        =   12
  19.       Top             =   480
  20.       Width           =   975
  21.    End
  22.    Begin VB.TextBox txtNumTweens 
  23.       Height          =   285
  24.       Left            =   4200
  25.       TabIndex        =   10
  26.       Text            =   "4"
  27.       Top             =   0
  28.       Width           =   375
  29.    End
  30.    Begin VB.TextBox txtFramesPerSecond 
  31.       Height          =   285
  32.       Left            =   4200
  33.       TabIndex        =   9
  34.       Text            =   "20"
  35.       Top             =   1770
  36.       Width           =   375
  37.    End
  38.    Begin VB.CommandButton cmdPlay 
  39.       Caption         =   "Play"
  40.       Default         =   -1  'True
  41.       Height          =   495
  42.       Left            =   3480
  43.       TabIndex        =   7
  44.       Top             =   3480
  45.       Width           =   975
  46.    End
  47.    Begin VB.OptionButton optPlay 
  48.       Caption         =   "Reversing"
  49.       Height          =   255
  50.       Index           =   2
  51.       Left            =   3360
  52.       TabIndex        =   4
  53.       Top             =   3000
  54.       Width           =   1095
  55.    End
  56.    Begin VB.OptionButton optPlay 
  57.       Caption         =   "Looping"
  58.       Height          =   255
  59.       Index           =   1
  60.       Left            =   3360
  61.       TabIndex        =   3
  62.       Top             =   2640
  63.       Width           =   1095
  64.    End
  65.    Begin VB.OptionButton optPlay 
  66.       Caption         =   "Once"
  67.       Height          =   255
  68.       Index           =   0
  69.       Left            =   3360
  70.       TabIndex        =   2
  71.       Top             =   2280
  72.       Value           =   -1  'True
  73.       Width           =   1095
  74.    End
  75.    Begin VB.HScrollBar sbarFrame 
  76.       Height          =   255
  77.       Left            =   0
  78.       Max             =   1
  79.       Min             =   1
  80.       TabIndex        =   1
  81.       Top             =   3960
  82.       Value           =   1
  83.       Width           =   3255
  84.    End
  85.    Begin VB.PictureBox picCanvas 
  86.       Height          =   3975
  87.       Left            =   0
  88.       ScaleHeight     =   261
  89.       ScaleMode       =   3  'Pixel
  90.       ScaleWidth      =   213
  91.       TabIndex        =   0
  92.       Top             =   0
  93.       Width           =   3255
  94.    End
  95.    Begin MSComDlg.CommonDialog dlgFile 
  96.       Left            =   2640
  97.       Top             =   4200
  98.       _ExtentX        =   847
  99.       _ExtentY        =   847
  100.       _Version        =   393216
  101.       CancelError     =   -1  'True
  102.    End
  103.    Begin VB.Label Label1 
  104.       Caption         =   "Tweens:"
  105.       Height          =   255
  106.       Index           =   2
  107.       Left            =   3360
  108.       TabIndex        =   11
  109.       Top             =   0
  110.       Width           =   615
  111.    End
  112.    Begin VB.Label Label1 
  113.       Alignment       =   2  'Center
  114.       Caption         =   "Frames per Second"
  115.       Height          =   375
  116.       Index           =   1
  117.       Left            =   3360
  118.       TabIndex        =   8
  119.       Top             =   1680
  120.       Width           =   855
  121.    End
  122.    Begin VB.Label lblFrame 
  123.       Alignment       =   2  'Center
  124.       BorderStyle     =   1  'Fixed Single
  125.       Caption         =   "1/1"
  126.       Height          =   255
  127.       Left            =   1680
  128.       TabIndex        =   6
  129.       Top             =   4320
  130.       Width           =   735
  131.    End
  132.    Begin VB.Label Label1 
  133.       Caption         =   "Frame:"
  134.       Height          =   255
  135.       Index           =   0
  136.       Left            =   1080
  137.       TabIndex        =   5
  138.       Top             =   4320
  139.       Width           =   495
  140.    End
  141.    Begin VB.Menu mnuFile 
  142.       Caption         =   "&File"
  143.       Begin VB.Menu mnuFileOpen 
  144.          Caption         =   "&Open..."
  145.          Shortcut        =   ^O
  146.       End
  147.       Begin VB.Menu mnuFileSave 
  148.          Caption         =   "&Save"
  149.          Shortcut        =   ^S
  150.       End
  151.       Begin VB.Menu mnuFileSaveAs 
  152.          Caption         =   "Save &As..."
  153.          Shortcut        =   ^A
  154.       End
  155.       Begin VB.Menu mnuFileSep1 
  156.          Caption         =   "-"
  157.       End
  158.       Begin VB.Menu mnuFileNew 
  159.          Caption         =   "&New"
  160.          Shortcut        =   ^N
  161.       End
  162.       Begin VB.Menu mnuFileSep2 
  163.          Caption         =   "-"
  164.       End
  165.       Begin VB.Menu mnuFileExit 
  166.          Caption         =   "E&xit"
  167.       End
  168.    End
  169.    Begin VB.Menu mnuFrame 
  170.       Caption         =   "Frame"
  171.       Begin VB.Menu mnuFrameAfter 
  172.          Caption         =   "Insert &After"
  173.       End
  174.       Begin VB.Menu mnuFrameBefore 
  175.          Caption         =   "Insert &Before"
  176.       End
  177.       Begin VB.Menu mnuFrameSep 
  178.          Caption         =   "-"
  179.       End
  180.       Begin VB.Menu mnuFrameClear 
  181.          Caption         =   "&Clear"
  182.       End
  183.       Begin VB.Menu mnuFrameDelete 
  184.          Caption         =   "&Delete"
  185.          Enabled         =   0   'False
  186.       End
  187.    End
  188. Attribute VB_Name = "frmTweenSmo"
  189. Attribute VB_GlobalNameSpace = False
  190. Attribute VB_Creatable = False
  191. Attribute VB_PredeclaredId = True
  192. Attribute VB_Exposed = False
  193. Option Explicit
  194. Private NumFrames As Integer
  195. Private Frames() As PolylineFrame
  196. Private FileName As String
  197. Private FileTitle As String
  198. Private DataModified As Boolean
  199. Private Playing As Boolean
  200. Private NumPlayed As Long
  201. Private SelectedFrame As Integer
  202. Private SelectingFrame As Boolean
  203. Private Drawing As Boolean
  204. Private StartX As Integer
  205. Private StartY As Integer
  206. Private LastX As Integer
  207. Private LastY As Integer
  208. Private Type Polyline
  209.     NumPoints As Integer
  210.     X() As Integer
  211.     Y() As Integer
  212. End Type
  213. Private Type PolylineFrame
  214.     NumPolylines As Integer
  215.     Poly() As Polyline
  216. End Type
  217. ' Insert a frame next to the selected one.
  218. Private Sub AddFrame()
  219. Dim i As Integer
  220.     NumFrames = NumFrames + 1
  221.     ReDim Preserve Frames(1 To NumFrames)
  222.     For i = NumFrames - 1 To SelectedFrame Step -1
  223.         CopyFrame i, i + 1
  224.     Next i
  225.     sbarFrame.Max = NumFrames
  226.     mnuFrameDelete.Enabled = (NumFrames > 1)
  227.     DataModified = True
  228.     Caption = "TweenSmo*[" & FileTitle & "]"
  229. End Sub
  230. ' Copy a polyline from frame1 to frame2.
  231. Private Sub CopyFrame(frame1 As Integer, frame2 As Integer)
  232. Dim pline As Integer
  233. Dim point As Integer
  234.     Frames(frame2).NumPolylines = Frames(frame1).NumPolylines
  235.     If Frames(frame2).NumPolylines < 1 Then
  236.         Erase Frames(frame2).Poly
  237.     Else
  238.         ReDim Frames(frame2).Poly(1 To Frames(frame2).NumPolylines)
  239.     End If
  240.     For pline = 1 To Frames(frame2).NumPolylines
  241.         With Frames(frame2).Poly(pline)
  242.             .NumPoints = Frames(frame1).Poly(pline).NumPoints
  243.             If .NumPoints < 1 Then
  244.                 Erase .X
  245.                 Erase .Y
  246.             Else
  247.                 ReDim .X(1 To .NumPoints)
  248.                 ReDim .Y(1 To .NumPoints)
  249.             End If
  250.             For point = 1 To .NumPoints
  251.                 .X(point) = Frames(frame1).Poly(pline).X(point)
  252.                 .Y(point) = Frames(frame1).Poly(pline).Y(point)
  253.             Next point
  254.         End With
  255.     Next pline
  256. End Sub
  257. ' Return true if the data has not been modified,
  258. ' or the user has saved the changes, or the user
  259. ' wants to lose the changes.
  260. Private Function DataSafe() As Boolean
  261. Dim ans As Integer
  262.     Do While DataModified
  263.         ans = MsgBox("The data has been modified." & _
  264.             " Do you want to save the changes?", _
  265.             vbYesNoCancel)
  266.         If ans = vbCancel Then Exit Do
  267.         If ans = vbNo Then
  268.             DataSafe = True
  269.             Exit Function
  270.         End If
  271.             
  272.         ' Otherwise save the data.
  273.         If FileName <> "" Then
  274.             mnuFileSave_Click
  275.         Else
  276.             mnuFileSaveAs_Click
  277.         End If
  278.     Loop
  279.     DataSafe = Not DataModified
  280. End Function
  281. ' Draw the indicated frame.
  282. Private Sub DrawFrame(frame As Integer)
  283. Dim pline As Integer
  284. Dim point As Integer
  285.     picCanvas.Cls
  286.     For pline = 1 To Frames(frame).NumPolylines
  287.         With Frames(frame).Poly(pline)
  288.             If .NumPoints >= 2 Then
  289.                 picCanvas.Line (.X(1), .Y(1))-(.X(2), .Y(2))
  290.                 For point = 3 To .NumPoints
  291.                     picCanvas.Line -(.X(point), .Y(point))
  292.                 Next point
  293.             End If
  294.         End With
  295.     Next pline
  296. End Sub
  297. ' Save the data.
  298. Private Sub SaveData(ByVal file_name As String, ByVal file_title As String)
  299. Dim fnum As Integer
  300. Dim frame As Integer
  301. Dim pline As Integer
  302. Dim point As Integer
  303.     On Error GoTo SaveDataError
  304.     ' Open the file.
  305.     fnum = FreeFile
  306.     Open file_name For Output As fnum
  307.     ' Save the number of frames.
  308.     Write #fnum, NumFrames
  309.     ' Save each frame.
  310.     For frame = 1 To NumFrames
  311.         With Frames(frame)
  312.             ' Save the number of polylines.
  313.             Write #fnum, .NumPolylines
  314.                     
  315.             ' Save each polyline.
  316.             For pline = 1 To .NumPolylines
  317.                 With .Poly(pline)
  318.                     ' Save the number of points.
  319.                     Write #fnum, .NumPoints
  320.                     For point = 1 To .NumPoints
  321.                         Write #fnum, .X(point), .Y(point)
  322.                     Next point
  323.                 End With
  324.             Next pline
  325.         End With
  326.     Next frame
  327.     Close fnum
  328.     FileName = file_name
  329.     FileTitle = file_title
  330.     Caption = "TweenSmo [" & FileTitle & "]"
  331.     DataModified = False
  332.     Exit Sub
  333. SaveDataError:
  334.     Beep
  335.     MsgBox "Error saving file " & file_name & "." & _
  336.         vbCrLf & Format$(Err.Number) & " : " & _
  337.         Err.Description
  338.     Exit Sub
  339. End Sub
  340. ' Load polyline frames from the file.
  341. Private Sub LoadData(ByVal file_name As String, ByVal file_title As String)
  342. Dim fnum As Integer
  343. Dim frame As Integer
  344. Dim pline As Integer
  345. Dim point As Integer
  346.     On Error GoTo SaveDataError
  347.     ' Open the file.
  348.     fnum = FreeFile
  349.     Open file_name For Input As fnum
  350.     ' Read the number of frames.
  351.     Input #fnum, NumFrames
  352.     ReDim Frames(1 To NumFrames)
  353.     sbarFrame.Max = NumFrames
  354.     ' Read each frame.
  355.     For frame = 1 To NumFrames
  356.         With Frames(frame)
  357.             ' Read the number of polylines.
  358.             Input #fnum, .NumPolylines
  359.             ReDim .Poly(1 To .NumPolylines)
  360.                     
  361.             ' Read each polyline.
  362.             For pline = 1 To .NumPolylines
  363.                 With .Poly(pline)
  364.                     ' Read the number of points.
  365.                     Input #fnum, .NumPoints
  366.                     ReDim .X(1 To .NumPoints)
  367.                     ReDim .Y(1 To .NumPoints)
  368.                     For point = 1 To .NumPoints
  369.                         Input #fnum, .X(point), .Y(point)
  370.                     Next point
  371.                 End With
  372.             Next pline
  373.         End With
  374.     Next frame
  375.     Close fnum
  376.     SelectFrame 1
  377.     FileName = file_name
  378.     FileTitle = file_title
  379.     Caption = "TweenSmo [" & FileTitle & "]"
  380.     DataModified = False
  381.     Exit Sub
  382. SaveDataError:
  383.     Beep
  384.     MsgBox "Error loading file " & file_name & "." & _
  385.         vbCrLf & Format$(Err.Number) & " : " & _
  386.         Err.Description
  387.     Exit Sub
  388. End Sub
  389. ' Select and display the indicated frame.
  390. Private Sub SelectFrame(num As Integer)
  391.     SelectedFrame = num
  392.     ' If we're drawing, stop drawing.
  393.     If Drawing Then
  394.         picCanvas.DrawMode = vbCopyPen
  395.         Drawing = False
  396.     End If
  397.     DrawFrame SelectedFrame
  398.     lblFrame.Caption = Format$(SelectedFrame) _
  399.          & "/" & Format$(NumFrames)
  400.     SelectingFrame = True
  401.     sbarFrame.Value = SelectedFrame
  402.     SelectingFrame = False
  403. End Sub
  404. ' Create the tweens between two key frames using
  405. ' Hermite curves.
  406. Private Sub MakeTweens(ByVal key2 As Integer, ByVal key3 As Integer)
  407. Dim tween As Integer
  408. Dim pline As Integer
  409. Dim point As Integer
  410. Dim key1 As Integer
  411. Dim key4 As Integer
  412. Dim x1 As Integer
  413. Dim y1 As Integer
  414. Dim x2 As Integer
  415. Dim y2 As Integer
  416. Dim x3 As Integer
  417. Dim y3 As Integer
  418. Dim x4 As Integer
  419. Dim y4 As Integer
  420. Dim dx1 As Integer
  421. Dim dy1 As Integer
  422. Dim dx2 As Integer
  423. Dim dy2 As Integer
  424. Dim t As Single
  425. Dim t2 As Single
  426. Dim t3 As Single
  427. Dim A As Single
  428. Dim B As Single
  429. Dim C As Single
  430. Dim D As Single
  431.     ' Make room for the points.
  432.     For tween = key2 + 1 To key3 - 1
  433.         Frames(tween).NumPolylines = Frames(key2).NumPolylines
  434.         ReDim Frames(tween).Poly(1 To Frames(tween).NumPolylines)
  435.         For pline = 1 To Frames(tween).NumPolylines
  436.             With Frames(tween).Poly(pline)
  437.                 .NumPoints = Frames(key2).Poly(pline).NumPoints
  438.                 ReDim .X(1 To .NumPoints)
  439.                 ReDim .Y(1 To .NumPoints)
  440.             End With
  441.         Next pline
  442.     Next tween
  443.     ' For each endpoint, create the tween endpoints.
  444.     For pline = 1 To Frames(key2).NumPolylines
  445.         With Frames(key2).Poly(pline)
  446.             For point = 1 To .NumPoints
  447.                 ' Pick slopes for the start & end.
  448.                 If key2 > 1 Then
  449.                     key1 = key2 - (key3 - key2)
  450.                 Else
  451.                     key1 = key2
  452.                 End If
  453.                 x1 = Frames(key1).Poly(pline).X(point)
  454.                 y1 = Frames(key1).Poly(pline).Y(point)
  455.                 x2 = .X(point)
  456.                 y2 = .Y(point)
  457.                 x3 = Frames(key3).Poly(pline).X(point)
  458.                 y3 = Frames(key3).Poly(pline).Y(point)
  459.                 If key3 < NumFrames Then
  460.                     key4 = key3 + (key3 - key2)
  461.                 Else
  462.                     key4 = key3
  463.                 End If
  464.                 x4 = Frames(key4).Poly(pline).X(point)
  465.                 y4 = Frames(key4).Poly(pline).Y(point)
  466.                 dx1 = x3 - x1
  467.                 dy1 = y3 - y1
  468.                 dx2 = x4 - x2
  469.                 dy2 = y4 - y2
  470.                 ' Compute the Hermite values.
  471.                 For tween = key2 + 1 To key3 - 1
  472.                     t = (tween - key2) / (key3 - key2)
  473.                     t2 = t * t
  474.                     t3 = t * t2
  475.                     A = 2 * t3 - 3 * t2 + 1
  476.                     B = -2 * t3 + 3 * t2
  477.                     C = t3 - 2 * t2 + t
  478.                     D = t3 - t2
  479.                     Frames(tween).Poly(pline).X(point) = x2 * A + x3 * B + dx1 * C + dx2 * D
  480.                     Frames(tween).Poly(pline).Y(point) = y2 * A + y3 * B + dy1 * C + dy2 * D
  481.                 Next tween
  482.             Next point
  483.         End With
  484.     Next pline
  485. End Sub
  486. Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  487.     If Drawing And Button = vbRightButton Then
  488.         ' End the previous polyline.
  489.         picCanvas.Line (StartX, StartY)-(LastX, LastY)
  490.         picCanvas.DrawMode = vbCopyPen
  491.         Drawing = False
  492.         Exit Sub
  493.     End If
  494.     ' See if this is the start of a new polyline.
  495.     If Drawing Then
  496.         ' Nope. Erase the previous line.
  497.         picCanvas.Line (StartX, StartY)-(LastX, LastY)
  498.     Else
  499.         ' Start a new polyline.
  500.         With Frames(SelectedFrame)
  501.             .NumPolylines = .NumPolylines + 1
  502.             ReDim Preserve .Poly(1 To .NumPolylines)
  503.             With .Poly(.NumPolylines)
  504.                 .NumPoints = 1
  505.                 ReDim .X(1 To 1)
  506.                 ReDim .Y(1 To 1)
  507.                 .X(1) = X
  508.                 .Y(1) = Y
  509.             End With
  510.         End With
  511.         picCanvas.DrawMode = vbInvert
  512.         Drawing = True
  513.         DataModified = True
  514.         Caption = "TweenSmo*[" & FileTitle & "]"
  515.         StartX = X
  516.         StartY = Y
  517.     End If
  518.     LastX = X
  519.     LastY = Y
  520.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  521. End Sub
  522. ' Repaint the current frame.
  523. Private Sub picCanvas_Paint()
  524.     If SelectingFrame Then Exit Sub
  525.     SelectFrame sbarFrame.Value
  526. End Sub
  527. Private Sub picCanvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  528.     If Not Drawing Then Exit Sub
  529.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  530.     LastX = X
  531.     LastY = Y
  532.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  533. End Sub
  534. Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  535.     If Not Drawing Then Exit Sub
  536.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  537.     picCanvas.DrawMode = vbCopyPen
  538.     picCanvas.Line (StartX, StartY)-(X, Y)
  539.     picCanvas.DrawMode = vbInvert
  540.     With Frames(SelectedFrame)
  541.         With .Poly(.NumPolylines)
  542.             .NumPoints = .NumPoints + 1
  543.             ReDim Preserve .X(1 To .NumPoints)
  544.             ReDim Preserve .Y(1 To .NumPoints)
  545.             .X(.NumPoints) = X
  546.             .Y(.NumPoints) = Y
  547.         End With
  548.     End With
  549.     DataModified = True
  550.     Caption = "TweenSmo*[" & FileTitle & "]"
  551.     StartX = X
  552.     StartY = Y
  553. End Sub
  554. ' Play the animation.
  555. Private Sub cmdPlay_Click()
  556.     If Playing Then
  557.         Playing = False
  558.         cmdPlay.Caption = "Stopped"
  559.         cmdPlay.Enabled = False
  560.     Else
  561.         Playing = True
  562.         cmdPlay.Caption = "Stop"
  563.         PlayData
  564.         cmdPlay.Caption = "Play"
  565.         Playing = False
  566.         cmdPlay.Enabled = True
  567.         DrawFrame SelectedFrame
  568.     End If
  569. End Sub
  570. ' Play the animation.
  571. Private Sub PlayData()
  572. Dim ms_per_frame As Long
  573. Dim start_time As Single
  574. Dim stop_time As Single
  575.     ' See how fast we should go.
  576.     If Not IsNumeric(txtFramesPerSecond.Text) Then _
  577.         txtFramesPerSecond.Text = "10"
  578.     ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
  579.     ' See what kind of animation this should be.
  580.     NumPlayed = 0
  581.     start_time = Timer
  582.     If optPlay(0).Value Then
  583.         PlayDataOnce ms_per_frame
  584.     ElseIf optPlay(1).Value Then
  585.         PlayDataLooping ms_per_frame
  586.     ElseIf optPlay(2).Value Then
  587.         PlayDataBackAndForth ms_per_frame
  588.     End If
  589.     stop_time = Timer
  590.     MsgBox "Displayed" & Str$(NumPlayed) & _
  591.         " frames in " & _
  592.         Format$(stop_time - start_time, "0.00") & _
  593.         " seconds (" & _
  594.         Format$(NumPlayed / (stop_time - start_time), "0.00") & _
  595.         " FPS)."
  596. End Sub
  597. ' Play the animation once.
  598. Private Sub PlayDataOnce(ByVal ms_per_frame As Long)
  599. Dim frame As Integer
  600. Dim next_time As Long
  601.     ' Start the animation.
  602.     next_time = GetTickCount()
  603.     For frame = 1 To NumFrames
  604.         If Not Playing Then Exit For
  605.         NumPlayed = NumPlayed + 1
  606.         ' Draw the frame.
  607.         DrawFrame frame
  608.         ' Wait until it's time for the next frame.
  609.         next_time = next_time + ms_per_frame
  610.         WaitTill next_time
  611.     Next frame
  612. End Sub
  613. ' Play the animation backwards.
  614. Private Sub PlayDataBackward(ByVal ms_per_frame As Long)
  615. Dim frame As Integer
  616. Dim next_time As Long
  617.     ' Start the animation.
  618.     next_time = GetTickCount()
  619.     For frame = NumFrames To 1 Step -1
  620.         If Not Playing Then Exit For
  621.         NumPlayed = NumPlayed + 1
  622.         ' Draw the frame.
  623.         DrawFrame frame
  624.         ' Wait until it's time for the next frame.
  625.         next_time = next_time + ms_per_frame
  626.         WaitTill next_time
  627.     Next frame
  628. End Sub
  629. ' Play the animation in a loop.
  630. Private Sub PlayDataLooping(ByVal ms_per_frame As Long)
  631.     Do While Playing
  632.         PlayDataOnce ms_per_frame
  633.     Loop
  634. End Sub
  635. ' Play the animation back and forth.
  636. Private Sub PlayDataBackAndForth(ByVal ms_per_frame As Long)
  637.     Do While Playing
  638.         PlayDataOnce ms_per_frame
  639.         If Not Playing Then Exit Do
  640.         PlayDataBackward ms_per_frame
  641.     Loop
  642. End Sub
  643. ' Make the tweens.
  644. Private Sub cmdTween_Click()
  645. Dim num_tweens As Integer
  646. Dim old_frames As Integer
  647. Dim frame1 As Integer
  648. Dim frame2 As Integer
  649. Dim frame As Integer
  650.     ' See how many tweens to make.
  651.     If Not IsNumeric(txtNumTweens.Text) Then _
  652.         txtNumTweens.Text = "4"
  653.     num_tweens = txtNumTweens.Text
  654.     If num_tweens < 1 Then num_tweens = 1
  655.     ' Make room for the new frames.
  656.     old_frames = NumFrames
  657.     NumFrames = num_tweens * (NumFrames - 1) + NumFrames
  658.     ReDim Preserve Frames(1 To NumFrames)
  659.     ' Spread the original frames out.
  660.     For frame = old_frames To 2 Step -1
  661.         CopyFrame frame, _
  662.             num_tweens * (frame - 1) + frame
  663.     Next frame
  664.     ' Make the tweens.
  665.     For frame = 1 To old_frames - 1
  666.         frame1 = num_tweens * (frame - 1) + frame
  667.         frame2 = frame1 + num_tweens + 1
  668.         MakeTweens frame1, frame2
  669.     Next frame
  670.     sbarFrame.Max = NumFrames
  671.     SelectFrame num_tweens * (SelectedFrame - 1) + _
  672.         SelectedFrame
  673.     DataModified = True
  674.     Caption = "TweenSmo*[" & FileTitle & "]"
  675. End Sub
  676. Private Sub Form_Load()
  677.     ' Position the scroll bar.
  678.     sbarFrame.Top = picCanvas.Top + picCanvas.Height + 1
  679.     ' Create an empty frame.
  680.     mnuFileNew_Click
  681.     dlgFile.InitDir = App.Path
  682.     dlgFile.Filter = _
  683.         "Tween Files (*.twe)|*.twe|" & _
  684.         "All Files (*.*)|*.*"
  685. End Sub
  686. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  687.     Cancel = Not DataSafe()
  688. End Sub
  689. Private Sub Form_Unload(Cancel As Integer)
  690.     End
  691. End Sub
  692. Private Sub mnuFileExit_Click()
  693.     Unload Me
  694. End Sub
  695. ' Load a data file.
  696. Private Sub mnuFileOpen_Click()
  697. Dim file_name As String
  698.     If Not DataSafe() Then Exit Sub
  699.     ' Allow the user to pick a file.
  700.     On Error Resume Next
  701.     dlgFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  702.     dlgFile.ShowOpen
  703.     If Err.Number = cdlCancel Then
  704.         Exit Sub
  705.     ElseIf Err.Number <> 0 Then
  706.         Beep
  707.         MsgBox "Error selecting file.", , vbExclamation
  708.         Exit Sub
  709.     End If
  710.     On Error GoTo 0
  711.     file_name = Trim$(dlgFile.FileName)
  712.     dlgFile.InitDir = Left$(file_name, Len(file_name) _
  713.         - Len(dlgFile.FileTitle) - 1)
  714.     ' Load the data file.
  715.     LoadData file_name, dlgFile.FileTitle
  716.     lblFrame.Caption = Format$(SelectedFrame) _
  717.          & "/" & Format$(NumFrames)
  718. End Sub
  719. ' Clear out all the data.
  720. Private Sub mnuFileNew_Click()
  721.     If Not DataSafe() Then Exit Sub
  722.     NumFrames = 1
  723.     ReDim Frames(1 To NumFrames)
  724.     Frames(1).NumPolylines = 0
  725.     sbarFrame.Max = NumFrames
  726.     SelectFrame 1
  727. End Sub
  728. ' Save the data file.
  729. Private Sub mnuFileSave_Click()
  730.     If FileName = "" Then
  731.         mnuFileSaveAs_Click
  732.         Exit Sub
  733.     End If
  734.     SaveData FileName, FileTitle
  735. End Sub
  736. ' Save the data file with a new name.
  737. Private Sub mnuFileSaveAs_Click()
  738. Dim file_name As String
  739.     ' Allow the user to pick a file.
  740.     On Error Resume Next
  741.     dlgFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  742.     dlgFile.ShowSave
  743.     If Err.Number = cdlCancel Then
  744.         Exit Sub
  745.     ElseIf Err.Number <> 0 Then
  746.         Beep
  747.         MsgBox "Error selecting file.", , vbExclamation
  748.         Exit Sub
  749.     End If
  750.     On Error GoTo 0
  751.     file_name = Trim$(dlgFile.FileName)
  752.     dlgFile.InitDir = Left$(file_name, Len(file_name) _
  753.         - Len(dlgFile.FileTitle) - 1)
  754.     ' Save the script file.
  755.     SaveData file_name, dlgFile.FileTitle
  756. End Sub
  757. ' Insert a frame after the selected one.
  758. Private Sub mnuFrameAfter_Click()
  759.     AddFrame
  760.     SelectFrame SelectedFrame + 1
  761. End Sub
  762. ' Insert a frame before the selected one.
  763. Private Sub mnuFrameBefore_Click()
  764.     AddFrame
  765.     lblFrame.Caption = Format$(SelectedFrame) & "/" & Format$(NumFrames)
  766. End Sub
  767. ' Remove the polylines from the selected frame.
  768. Private Sub mnuFrameClear_Click()
  769. Dim i As Integer
  770.     With Frames(SelectedFrame)
  771.         .NumPolylines = 0
  772.         Erase .Poly
  773.     End With
  774.     SelectFrame SelectedFrame
  775.     DataModified = True
  776.     Caption = "TweenSmo*[" & FileTitle & "]"
  777. End Sub
  778. ' Delete the selected frame.
  779. Private Sub mnuFrameDelete_Click()
  780. Dim i As Integer
  781.     For i = SelectedFrame To NumFrames - 1
  782.         CopyFrame i + 1, i
  783.     Next i
  784.     NumFrames = NumFrames - 1
  785.     ReDim Preserve Frames(1 To NumFrames)
  786.     sbarFrame.Max = NumFrames
  787.     If SelectedFrame > NumFrames Then _
  788.        SelectedFrame = NumFrames
  789.     SelectFrame SelectedFrame
  790.     mnuFrameDelete.Enabled = (NumFrames > 1)
  791.     DataModified = True
  792.     Caption = "TweenSmo*[" & FileTitle & "]"
  793. End Sub
  794. ' Select a new frame.
  795. Private Sub sbarFrame_Change()
  796.     If SelectingFrame Then Exit Sub
  797.     SelectFrame sbarFrame.Value
  798. End Sub
  799. ' Select a new frame.
  800. Private Sub sbarFrame_Scroll()
  801.     sbarFrame_Change
  802. End Sub
  803.