Exemple d'animation d'un personnage

Commenter

Contenu du snippet

animation d'un personnage de jeu type double dragon.

Source / Exemple : 


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
Dim PosX As Integer
Dim PosY As Integer
Const SRCAND = &H8800C6
Const SRCPAINT = &HEE0086
Dim Frames As Integer
Dim Col As Integer
Dim Tickz As Integer
Dim CMove As String
Dim LastStand As String
Public Function GetKey(lngKey As Long) As Boolean
If GetKeyState(lngKey&) < 0 Then
    GetKey = True
Else
    GetKey = False
End If
End Function

Private Sub Form_Load()
' The character starts facing down, and standing...
LastStand$ = "right"
' The character starts standing.
CMove$ = "stand"
' Just to set the right size, if it isn't in design time.
Me.Height = 5400
' The starting position is in the middle (sort of)
PosX = Picture1.ScaleWidth / 2 - 500
' Just the starting PosY
PosY = 185
' I had to change it a lot, so instead of loading the new picture all the time, I
' just added in the code.  Blah!  Heheh.
Picture1.Picture = LoadPicture(App.Path$ & "\bg.bmp")
End Sub

Private Sub Timer1_Timer()
' Timer1 is the refresh timer.  This timer is required for your computer
' to BitBlt the picture.
If GetKey(vbKeyLeft) Then
    ' If the left key is being pressed, move left and set variables for left.
  
    PosX = PosX - 6
    CMove$ = "left"
    LastStand$ = "left"
End If
If GetKey(vbKeyUp) Then
    ' If the right key is being pressed, move right and set variables for right.

    PosY = PosY - 6
    CMove$ = "right"
    LastStand$ = "right"
End If
If GetKey(vbKeyDown) Then
    ' If the right key is being pressed, move right and set variables for right.

    PosY = PosY + 6
    CMove$ = "right"
    LastStand$ = "right"
End If
If GetKey(vbKeyRight) Then
    ' If the right key is being pressed, move right and set variables for right.

    PosX = PosX + 6
    CMove$ = "right"
    LastStand$ = "right"
End If

If GetKey(vbKeyLeft) = False And GetKey(vbKeyRight) = False And GetKey(vbKeyUp) = False And GetKey(vbKeyDown) = False Then
    ' If none of the keys are being held down, set it in stand mode.
    CMove$ = "stand"
End If
If PosY >= 210 Then
PosY = 209
End If
If PosY <= 170 Then
PosY = 171
End If
' Make sure the character can't go offscreen.

' Collision detection on the Crates.

        
' Clears the picture box.  Also is required.
Picture1.Cls
' Paints the pictures, if in stand mode!!!
' Note:  Transparancy requires two BitBlts.
If CMove$ = "stand" Then
    If LastStand$ = "down" Then
        BitBlt Picture1.hDC, PosX, PosY, 129, 48, dChr2.hDC, 0, 0, SRCPAINT
        BitBlt Picture1.hDC, PosX, PosY, 129, 48, dChr1.hDC, 0, 0, SRCAND
    End If
    If LastStand$ = "left" Then
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, lChr2.hDC, 0, 0, SRCPAINT
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, lChr1.hDC, 0, 0, SRCAND
    End If
    If LastStand$ = "right" Then
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, rChr2.hDC, 0, 0, SRCPAINT
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, rChr1.hDC, 0, 0, SRCAND
    End If
    If LastStand$ = "up" Then
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, uChr2.hDC, 0, 0, SRCPAINT
        BitBlt Picture1.hDC, PosX, PosY, 130, 134, uChr1.hDC, 0, 0, SRCAND
    End If
End If
' Paints pictures!!!
If CMove$ = "down" Then
    ' If the character is moving down, paint the down character, and the
    ' sprite that it's currently on.
    BitBlt Picture1.hDC, PosX, PosY, 32, 48, dChr2.hDC, Tickz, 0, SRCPAINT
    BitBlt Picture1.hDC, PosX, PosY, 32, 48, dChr1.hDC, Tickz, 0, SRCAND
End If
If CMove$ = "left" Then
    ' Same as above, but left.
    BitBlt Picture1.hDC, PosX, PosY, 130, 134, lChr2.hDC, Tickz, 0, SRCPAINT
    BitBlt Picture1.hDC, PosX, PosY, 130, 134, lChr1.hDC, Tickz, 0, SRCAND
End If
If CMove$ = "right" Then
    ' Same as above, but right.
    BitBlt Picture1.hDC, PosX, PosY, 130, 134, rChr2.hDC, Tickz, 0, SRCPAINT
    BitBlt Picture1.hDC, PosX, PosY, 130, 134, rChr1.hDC, Tickz, 0, SRCAND
End If
If CMove$ = "up" Then
    ' Same as above, but up.
    BitBlt Picture1.hDC, PosX, PosY, 130, 48, uChr2.hDC, Tickz, 0, SRCPAINT
    BitBlt Picture1.hDC, PosX, PosY, 130, 48, uChr1.hDC, Tickz, 0, SRCAND
End If
' The Frames Per Second (FPS).
Frames = Frames + 1

End Sub

Private Sub Timer2_Timer()
' Print the Frame Rate and stuff.
Me.Caption = "une demo par manssour K, Frame  : " & Frames
' Reset the Frame Rate.
Frames = 0
End Sub

Private Sub Timer3_Timer()
' Change the collumn number.
Col = Col + 1
If Col = 6 Then
    ' 3 is the max, so if it's 4, reset it back to 0.
    Col = 0
End If
If Col = 0 Then
    ' The start point for Col 0 is pixel 0.
    Tickz = 130
End If
If Col = 1 Then
    ' The start point for Col 1 is pixel 32.
    Tickz = 260
End If
If Col = 2 Then
    ' The start point for Col 2 is pixel 64.
    Tickz = 390
End If
If Col = 3 Then
    ' The start point for Col 3 is pixel 96.
    Tickz = 520
    End If
    
If Col = 4 Then
    Tickz = 650
    End If

    End Sub
Private Sub Timer4_Timer()
If GetKey(vbKeyLeft) Then
    ' If the left key is being pressed, move left and set variables for left.
    Picture1.Left = Picture1.Left + 30

End If
If GetKey(vbKeyRight) Then
Picture1.Left = Picture1.Left - 30
End If
End Sub

Conclusion :


IL vous faut une image bg.bmp pour le fond dans le meme dossier.
je nai pu mettre que le code je n'arrive a uploader le zip le zip fai + de 700ko

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (wcwmans)