animat03.frm

一个屏幕 动 画的演示程序(例子 )

VERSION 4.00
Begin VB.Form Animate03 
   Caption         =   "Animate03 by Tim Overbay"
   ClientHeight    =   5688
   ClientLeft      =   3540
   ClientTop       =   1248
   ClientWidth     =   6744
   ClipControls    =   0   'False
   Height          =   6012
   Left            =   3492
   LinkTopic       =   "Form1"
   ScaleHeight     =   474
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   562
   Top             =   972
   Width           =   6840
   Begin VB.VScrollBar scrYInc 
      Height          =   252
      LargeChange     =   10
      Left            =   4560
      Max             =   100
      Min             =   -100
      TabIndex        =   10
      Top             =   5280
      Width           =   132
   End
   Begin VB.VScrollBar scrXInc 
      Height          =   252
      LargeChange     =   10
      Left            =   2040
      Max             =   100
      Min             =   -100
      TabIndex        =   9
      Top             =   5280
      Value           =   30
      Width           =   132
   End
   Begin VB.TextBox txtYInc 
      Height          =   288
      Left            =   4680
      TabIndex        =   7
      Text            =   "0"
      Top             =   5280
      Width           =   492
   End
   Begin VB.TextBox txtXInc 
      Height          =   288
      Left            =   2160
      TabIndex        =   5
      Text            =   "30"
      Top             =   5280
      Width           =   492
   End
   Begin VB.CheckBox chkOption 
      Caption         =   "Movement"
      Height          =   252
      Index           =   1
      Left            =   2280
      TabIndex        =   4
      Top             =   4800
      Value           =   1  'Checked
      Width           =   1692
   End
   Begin VB.CheckBox chkOption 
      Caption         =   "Animation"
      Height          =   252
      Index           =   0
      Left            =   600
      TabIndex        =   3
      Top             =   4800
      Value           =   1  'Checked
      Width           =   1692
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   120
      Top             =   4800
   End
   Begin VB.CommandButton cmdAni 
      Caption         =   "Animate"
      Height          =   372
      Left            =   5400
      TabIndex        =   2
      Top             =   4800
      Width           =   1212
   End
   Begin VB.PictureBox Picture1 
      Height          =   4572
      Left            =   120
      ScaleHeight     =   377
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   537
      TabIndex        =   1
      Top             =   120
      Width           =   6492
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   372
      Left            =   5400
      TabIndex        =   0
      Top             =   5280
      Width           =   1212
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Vertical Increment"
      Height          =   252
      Index           =   1
      Left            =   2880
      TabIndex        =   8
      Top             =   5280
      Width           =   1572
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "Horizontal Increment"
      Height          =   252
      Index           =   0
      Left            =   240
      TabIndex        =   6
      Top             =   5280
      Width           =   1692
   End
End
Attribute VB_Name = "Animate03"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim XIncrement As Long, YIncrement As Long      'Used to store how far to move the
                                                'horizontally & vertically

Dim ScrollBG As Long                            'Used to scroll the background


Dim CatBuffer As New BitMapBuffer               'The BitmapBuffer for the sprite
Dim Cat As New Sprite                           'The Sprite object
Dim BG As New BitMapBuffer                      'The BitmapBuffer for the Background
Dim Stage As New BitMapBuffer                   'The BitmapBuffer for the off-screen
                                                'staging area

Private Sub chkOption_Click(Index As Integer)
    'Set the Status flag of the sprite
    'Bit 1 is for Animation
    'Bit 2 is for Movement
    'The Paint method of the sprite checks this flag before it paints anything
    Cat.Status = chkOption(0) + 2 * chkOption(1)
    Timer1_Timer        'Immediately cycle the animation, otherwise,
                        'There's a pause until the next Timer event.
End Sub

Private Sub cmdAni_Click()
'This function toggles the cmdAni button between Animate and Stop
    If Timer1.Enabled = True Then           'If the timer is already enabled
        Timer1.Enabled = False              'turn it off
        cmdAni.Caption = "Animate"          'change the button to 'Animate'
    Else                                    'if the timer is disabled
        Timer1.Enabled = True               'turn it on
        cmdAni.Caption = "Stop"             'change the button to 'Stop'
    End If
'When the timer is enabled, the Timer1_Timer event procedure is called every 60th
'of a second. That is where the animation actually takes place.
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub


Private Sub Form_Activate()
    Picture1.Picture = LoadPicture(App.Path + "\backgnd.bmp")
    'Set the path & name of the sprite bitmap for the BitmapBuffer.
    'This also sets the Width & Height of the buffer.
    CatBuffer.BitmapFile = App.Path + "\catwalk.bmp"
    
    'Create the buffer and load Catwalk.bmp into it.
    CatBuffer.Create
    'Set some parameters for the Cat sprite
    With Cat
        .CelhDC = CatBuffer.Handle      'Points to the handle of the buffer
        .XCoord = 0                     'Sets the starting X coordinate of the sprite
        .YCoord = 300                   'Sets the starting Y coordinate of the sprite
        .CelWidth = 115                 'Sets the Width of each cel in the sprite
        .CelHeight = 64                 'Sets the Height of each cel in the sprite
        .CelStartX = 0                  'CelStartX & CelStartY Indicate the upper left
        .CelStartY = 0                  ' corner of the group of cels for this sprite
        .CelCount = 4                   'Sets the number of cels for this sprite
        .CelNum = 0                     'Sets the current cel for this sprite
        .Status = Animated + Moving     'Sets the status of this sprite
    End With
    
    'XIncrement & Yincrement are used to control how the sprite moves
    XIncrement = 30                     'The sprite will move 30 pixels to the right
                                        'for each iteration
    YIncrement = 0                      'The sprite will move 0 pixels vertically
                                        'for each iteration
    
    'Set the path & name of the background bitmap for the BitmapBuffer.
    'This also sets the Width & Height of the buffer.
    BG.BitmapFile = App.Path + "\backgnd.bmp"
    
    'Create the buffer and load Catwalk.bmp into it.
    BG.Create
    
    'Sets the Width & Height of the viewport (Picture1)
    ScalePic Picture1, 540, BG.Height
    
    'This is the staging area so no bitmap needs to be loaded into it
    'initially. Therefore, you don't (and shouldn't) set a bitmap for
    'This buffer.  You do need to specify the width & height, though,
    'because it can't get that information from a bitmap.
    Stage.Create 540, 380
    
    'un-Rem this statement for a full-screen window.
    Rem GameScreen Form1
End Sub

Private Sub scrXInc_Change()
    'This just sets the Text in txtXInc to the value of
    'the scrollbar. It effectively changes the XIncrement
    'value.
    txtXInc = scrXInc
End Sub

Private Sub scrYInc_Change()
    'This just sets the Text in txtYInc to the value of
    'the scrollbar. It effectively changes the YIncrement
    'value.
    txtYInc = scrYInc
End Sub

Private Sub Timer1_Timer()
'This procedure is where everything comes
'together to animate the sprite
    
    Dim tmpVal As Long                  'Temporary variable for the return code of the API functions
    Dim ScrollExtra                     'Store the width of any extra background while scrolling
    
    'Check if the sprite has gone outside the limits of the viewport.
    If Cat.XCoord > Stage.Width Then Cat.XCoord = 0 - Cat.CelWidth      'Allow for the width of the cels
    If Cat.YCoord > Stage.Height Then Cat.YCoord = 0 - Cat.CelHeight
    If Cat.XCoord < -Cat.CelWidth Then Cat.XCoord = Stage.Width
    If Cat.YCoord < -Cat.CelHeight Then Cat.YCoord = Stage.Height
    
    ScrollExtra = ScrollBG - Stage.Width    'Set the width of the extra background
    
    'First, Blit the Background onto the Stage buffer.
    'ScrollBG is the current position of the scrolling background.
    BitBlt Stage.Handle, 0, 0, Stage.Width, Stage.Height, BG.Handle, ScrollBG, 0, SRCCOPY
    
    'Check for any extra background left over. If there is,
    'Blit a chunk from the beginning of the buffer.
    If ScrollExtra > 0 Then tmpVal = BitBlt(Stage.Handle, Stage.Width - ScrollExtra, 0, ScrollExtra, Stage.Height, BG.Handle, 0, 0, SRCCOPY)
    
    'Then copy the the sprite to the stage.
    Cat.Paint Stage.Handle
    
    'Finally, copy the entire staging area back to the viewport (Picture1)
    BitBlt Picture1.hDC, 0, 0, 540, 380, Stage.Handle, 0, 0, SRCCOPY
    
    'Then increment the positions of the sprite and the background
    'The background is scrolled 10 pixels to the left
    ScrollBG = ScrollBG + 10
    'Check ScrollBG to see if it's passed the end of the background.
    If ScrollBG > BG.Width Then ScrollBG = 0
    
    'If the Moving bit of the Status property is on then increment
    'the sprite's position.
    If (Cat.Status And Moving) Then
        Cat.XCoord = Cat.XCoord + XIncrement            'Horizontal movement
        Cat.YCoord = Cat.YCoord + YIncrement            'Vertical movement
    End If
End Sub

Private Sub txtXInc_Change()
    'The Minimum & Maximum values of the scrollbars are
    '-100 & 100 respectively. This checks the txtXInc
    'Text Box to make sure it's within this range.
    If Val(txtXInc.Text) > 100 Then txtXInc.Text = "100"
    If Val(txtXInc.Text) < -100 Then txtXInc.Text = "-100"
    
    'Changes the value of XIncrement and effectively
    'changes the way the sprite moves horizontally
    XIncrement = Val(txtXInc.Text)
    
    'Update the scrollbar to reflect the new value.
    scrXInc = Val(txtXInc.Text)
End Sub


Private Sub txtYInc_Change()
    'The Minimum & Maximum values of the scrollbars are
    '-100 & 100 respectively. This checks the txtYInc
    'Text Box to make sure it's within this range.
    If Val(txtXInc.Text) > 100 Then txtXInc.Text = "100"
    If Val(txtXInc.Text) < -100 Then txtXInc.Text = "-100"
    
    'Changes the value of XIncrement and effectively
    'changes the way the sprite moves vertically
    YIncrement = Val(txtYInc.Text)
    
    'Update the scrollbar to reflect the new value.
    scrYInc = Val(txtYInc.Text)
End Sub