Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH5/SRC/BMPPLAY.FRM

Visual Basic Form | 1996-05-02 | 9.3 KB | 314 lines

VERSION 4.00
Begin VB.Form PlayerForm
   Caption         =   "Bitmap Player"
   ClientHeight    =   3825
   ClientLeft      =   1680
   ClientTop       =   975
   ClientWidth     =   5850
   Height          =   4515
   Left            =   1620
   LinkTopic       =   "Form1"
   ScaleHeight     =   255
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   390
   Top             =   345
   Width           =   5970
   Begin VB.TextBox NumFramesText
      Height          =   285
      Left            =   1560
      TabIndex        =   11
      Text            =   "100"
      Top             =   120
      Width           =   375
   End
   Begin VB.OptionButton RunType
      Caption         =   "Looping"
      Height          =   255
      Index           =   2
      Left            =   360
      TabIndex        =   9
      Top             =   2400
      Width           =   1095
   End
   Begin VB.OptionButton RunType
      Caption         =   "Reversing"
      Height          =   255
      Index           =   1
      Left            =   360
      TabIndex        =   8
      Top             =   2040
      Width           =   1095
   End
   Begin VB.OptionButton RunType
      Caption         =   "One time"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   7
      Top             =   1680
      Value           =   -1  'True
      Width           =   1095
   End
   Begin VB.TextBox FPSText
      Height          =   285
      Left            =   1560
      TabIndex        =   6
      Text            =   "20"
      Top             =   1080
      Width           =   375
   End
   Begin VB.PictureBox MovieImage
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   600
      ScaleHeight     =   21
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   21
      TabIndex        =   2
      Top             =   3480
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.CommandButton CmdStart
      Caption         =   "Start"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   600
      TabIndex        =   1
      Top             =   3000
      Width           =   855
   End
   Begin VB.PictureBox Canvas
      Height          =   3810
      Left            =   2040
      ScaleHeight     =   250
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   250
      TabIndex        =   0
      Top             =   0
      Width           =   3810
   End
   Begin VB.Label Label2
      Caption         =   "Frames to load:"
      Height          =   255
      Left            =   120
      TabIndex        =   10
      Top             =   120
      Width           =   1455
   End
   Begin VB.Label Label1
      Caption         =   "Frames per second:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   5
      Top             =   1080
      Width           =   1455
   End
   Begin VB.Label NumLabel
      BorderStyle     =   1  'Fixed Single
      Caption         =   "0"
      Height          =   255
      Left            =   1560
      TabIndex        =   4
      Top             =   480
      Width           =   375
   End
   Begin VB.Label Label1
      Caption         =   "Frame:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   3
      Top             =   480
      Width           =   615
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   0
      Top             =   3360
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
      cancelerror     =   -1  'True
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileLoad
         Caption         =   "&Load..."
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuFileSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "PlayerForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim NumImages As Integer
Dim MaxImage As Integer
Dim Playing As Boolean
' ************************************************
' Load the images.
' ************************************************
Sub LoadImages(fname As String)
Dim base As String
Dim i As Integer
    ' Get the base file name.
    base = Left$(fname, Len(fname) - 5)
    ' See how many frames the user wants to load.
    If Not IsNumeric(NumFramesText.Text) Then _
        NumFramesText.Text = Format$(10)
    NumImages = CInt(NumFramesText.Text)
    ' Create any needed picture boxes.
    For i = MaxImage + 1 To NumImages - 1
        Load MovieImage(i)
    Next i
    ' Get rid of any that are no longer needed.
    For i = NumImages To MaxImage
        Unload MovieImage(i)
    Next i
    MaxImage = NumImages - 1
    ' Load the images.
    On Error GoTo LoadPictureError
    i = 0
    Do While i < NumImages
        NumLabel.Caption = Format$(i + 1)
        NumLabel.Refresh
        MovieImage(i).Picture = LoadPicture(base & Format$(i) & ".bmp")
        i = i + 1
    Loop
    Canvas.Picture = MovieImage(0).Image
    NumLabel.Caption = "0"
    NumFramesText.Text = Format$(NumImages)
    Exit Sub
LoadPictureError:
    ' We ran out of images early.
    NumImages = i
    NumFramesText.Text = Format$(NumImages)
    Resume Next
End Sub
' ***********************************************
' Run the animation until Playing is false.
' ***********************************************
Sub PlayImages()
Const RUN_TYPE_ONE_TIME = 0
Const RUN_TYPE_BACK_AND_FORTH = 1
Const RUN_TYPE_LOOPING = 2
Dim i As Integer
Dim ms_per_frame As Integer
Dim next_time As Long
Dim run_type As Integer
    ' See long it should be between frames.
    If Not IsNumeric(FPSText.Text) Then _
        FPSText.Text = "20"
    ms_per_frame = 1000 / CInt(FPSText.Text)

    ' See what kind of run it is (looping, etc.).
    For i = 0 To 2
        If RunType(i).Value Then Exit For
    Next i
    run_type = i
    ' Start the animation.
    next_time = GetTickCount
    Do While Playing
        For i = 0 To NumImages - 1
            Canvas.Picture = MovieImage(i).Image
            NumLabel.Caption = Format$(i)
            next_time = next_time + ms_per_frame
            WaitTill next_time

            If Not Playing Then Exit Sub
        Next i

        ' If this is a one time run, stop.
        If run_type = RUN_TYPE_ONE_TIME Then Exit Do

        ' If this is a back and forth run, go back.
        If run_type = RUN_TYPE_BACK_AND_FORTH Then
            For i = NumImages - 2 To 1 Step -1
                Canvas.Picture = MovieImage(i).Image
                NumLabel.Caption = Format$(i)
                next_time = next_time + ms_per_frame
                WaitTill next_time

                If Not Playing Then Exit Sub
            Next i
        End If
    Loop
End Sub
' ************************************************
' Start or stop playing.
' ************************************************
Private Sub CmdStart_Click()
    If Playing Then
        Playing = False
        CmdStart.Caption = "Stopped"
        CmdStart.Enabled = False
    Else
        CmdStart.Caption = "Stop"
        Playing = True
        PlayImages
        Playing = False
        CmdStart.Caption = "Start"
        CmdStart.Enabled = True
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ***********************************************
' Load new image files.
' ***********************************************
Private Sub mnuFileLoad_Click()
Dim fname As String
    ' Allow the user to pick a file.
    On Error Resume Next
    FileDialog.filename = "*_0.BMP"
    FileDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
    FileDialog.ShowOpen
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        Beep
        MsgBox "Error selecting file.", , vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    fname = Trim$(FileDialog.filename)
    FileDialog.InitDir = Left$(fname, Len(fname) _
        - Len(FileDialog.FileTitle) - 1)
    ' Load the pictures.
    WaitStart
    LoadImages fname
    WaitEnd
    CmdStart.Enabled = True
End Sub
' ***********************************************
' Restore the mouse pointers for the form and all
' the picture boxes.
' ***********************************************
Sub WaitEnd()
    MousePointer = vbDefault
    Canvas.MousePointer = vbDefault
End Sub
' ***********************************************
' Give the form and all the picture boxes an
' hourglass cursor.
' ***********************************************
Sub WaitStart()
    MousePointer = vbHourglass
    Canvas.MousePointer = vbHourglass
    DoEvents
End Sub