clshero.cls

是游戏的很好的代码,为每个手写代码的开发者,游戏人才的开发也是这个的.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsHero"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'**************************************************
'* Date   : 08/22/2002                            *
'* Name   : Matthias Bartelt                      *
'* Changed: 08/22/2002                            *
'* Info   : Here are the heros' data stored.      *
'**************************************************

'Variables must be declared
Option Explicit


'**************************************************
'*------------------------------------------------*
'*------------------DECLARATIONS------------------*
'*------------------------------------------------*
'**************************************************

'*** API
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long


'*** Constants
Private Const KEY_TOGGLED  As Integer = &H1
Private Const KEY_DOWN     As Integer = &H1000
Private Const m_Def_iSpeed As Integer = 100
Private Const m_Def_iStepX As Integer = 50
Private Const SND_ASYNC = &H1
Private Const SND_FILENAME = &H20000

'*** Enums
Public Enum SPEED
    enmVERYSLOW = 500
    enmSLOW = 250
    enmMEDIUM = 100
    enmFAST = 30
    enmVERYFAST = 15
    enmULTRAFAST = 1
End Enum

'*** Types

'*** Variables
Dim bMoving       As Boolean
Dim bShoot        As Boolean
Dim iSpritStep    As Integer
Dim iSpritWidth   As Integer
Dim lOldTickCount As Long
Dim lTickCount    As Long
Dim m_iSpeed      As Integer
Dim m_iSpritCount As Integer
Dim m_objForm     As Form
Dim m_objPicBox   As PictureBox
Dim m_iStepX      As Integer




'**************************************************
'*------------------------------------------------*
'*-----------------FUNCTIONS/SUBS-----------------*
'*------------------------------------------------*
'**************************************************

Private Sub Class_Initialize()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : When the class is initializing.  *
'**************************************************

    'Set the standard values
    m_iSpeed = m_Def_iSpeed
    
End Sub

Private Sub Class_Terminate()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : When the class is terminates.    *
'**************************************************

    'Delete the object
    Set m_objForm = Nothing
    Set m_objPicBox = Nothing

End Sub

Public Sub sStartMoving()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Starts the animation.            *
'**************************************************

    'Set the variable
    bMoving = True
    
    'Start moving
    Call sMove

End Sub

Public Sub sStopMoving()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Stop the animation.              *
'**************************************************

    'Set the variable
    bMoving = False

End Sub

Private Sub sMove()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Make the animation.              *
'**************************************************
    
    'Start game loop
    Do
        'Get the counter
        lTickCount = GetTickCount()
        
        'Check if a key is pressed
        If (fKeyPressed(vbKeySpace)) Then
            'Creates a new shoot
            If Not (bShoot) Then Call sShoot
        End If

        'Check the difference (for the movement)
        If (lTickCount - lOldTickCount) > m_iSpeed Then
            'Save the tick count
            lOldTickCount = GetTickCount()
            'Set the new position of the sprite
            iSpritStep = iSpritStep + iSpritWidth
            'Check if it is the end of the sprite image
            If iSpritStep >= m_objPicBox.ScaleWidth Then iSpritStep = 0
            'Clear the form
            m_objForm.Cls
            'Copy the sprite to the form
            BitBlt m_objForm.hDC, 0, 0, iSpritWidth, iSpritWidth, m_objPicBox.hDC, iSpritStep, 0, vbSrcCopy
            'Set the region
            Call CSystem.sSetFormRegion(m_objForm, vbMagenta)
            'Set the vertical position of the form
            Call sSetPositionY
            'Move the form one step left
            m_objForm.Left = m_objForm.Left + m_iStepX
            If m_objForm.Left >= Screen.Width Then m_objForm.Left = 0
        End If
        
        'Check if the shoot should be moved, too
         If (bShoot) Then
            'Move it
            objShoot.Left = objShoot.Left + 5
            'Check if it out of the screen
            If (objShoot.Left > Screen.Width) Then
                'Clear the object
                Set objShoot = Nothing
                bShoot = False
            End If
        End If
            
        'Do not interrupt other processes
        DoEvents
    'Loop until the variable is declared as 'true'
    Loop While (bMoving)

    'Clear the memory
    Set objShoot = Nothing

End Sub

Private Sub sShoot()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Make the animation.              *
'**************************************************
    
    'Check if a shoot exist
    If (bShoot) Then Exit Sub
    
    'Variables
    Dim sWavFile As String
    sWavFile = App.Path & "\data\shoot.wav"
    
    'Load a new form
    Set objShoot = New frmShoot
    bShoot = True
    
    'Play the sound
    If Dir(sWavFile) <> "" Then _
        sndPlaySound sWavFile, SND_ASYNC Or SND_FILENAME
    
    'Set the position
    With objShoot
        .Left = m_objForm.Left + m_objForm.Width
        .Top = m_objForm.Top + (m_objForm.Height / 3)
        .Visible = True
    End With

End Sub

Private Sub sSetPositionY()
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Set the top positon of the form. *
'**************************************************

    'Do not interrupt other processes
    DoEvents
    
    'Set the position
    With m_objForm
        'Get the taskbar position and the the new form pos.
        If (CSystem.fGetTaskbarPos(enmtop) < _
            (Screen.Height / Screen.TwipsPerPixelY) / 2) Then
            .Top = Screen.Height - .Height
        Else
            .Top = Screen.Height - .Height - _
            ((CSystem.fGetTaskbarPos(enmBottom) - _
            CSystem.fGetTaskbarPos(enmtop)) * Screen.TwipsPerPixelY) + _
            (2 * Screen.TwipsPerPixelY)
        End If
    End With

End Sub

Private Function fKeyPressed( _
    ByVal lKeyCode As Long _
    ) As Boolean
'**************************************************
'* Changed     : 08/22/2002                       *
'* Info        : Is a key pressed.                *
'**************************************************

    'Check if the key is pressed
    fKeyPressed = CBool((GetKeyState(lKeyCode) And KEY_DOWN))

End Function




'**************************************************
'*------------------------------------------------*
'*--------------------GET/LET---------------------*
'*------------------------------------------------*
'**************************************************

Public Property Get gForm() As Form
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Returns the value
    Set gForm = m_objForm
    
End Property

Public Property Let gForm( _
    ByVal objNewValue As Form _
    )
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Set the new value
    Set m_objForm = objNewValue
    
End Property

Public Property Get gPictureBox() As PictureBox
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Returns the value
    Set gPictureBox = m_objPicBox
 
End Property

Public Property Let gPictureBox( _
    ByVal objNewValue As PictureBox _
    )
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Check if the "m_iSpritCount" variable is set
    If (m_iSpritCount = 0) Then m_iSpritCount = 1

    'Set the new value
    Set m_objPicBox = objNewValue
        
    'Set the sprit width
    iSpritWidth = (objNewValue.ScaleWidth / m_iSpritCount)
   
End Property

Public Property Get gSpeed() As SPEED
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Returns the value
    gSpeed = m_iSpeed
    
End Property

Public Property Let gSpeed( _
    ByVal iNewValue As SPEED _
    )
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Set the new value
    m_iSpeed = iNewValue
    
End Property

Public Property Get gSpritCount() As Integer
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Returns the value
    gSpritCount = m_iSpritCount
    
End Property

Public Property Let gSpritCount( _
    ByVal iNewValue As Integer _
    )
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Set the new value
    m_iSpritCount = iNewValue
    
End Property

Public Property Get gStepX() As Integer
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Returns the value
    gStepX = m_iStepX
    
End Property

Public Property Let gStepX( _
    ByVal iNewValue As Integer _
    )
'**************************************************
'* Changed     : 08/22/2002                       *
'* Special     : NONE                             *
'**************************************************

    'Set the new value
    m_iStepX = iNewValue
    
End Property