Snake

Télécharger le projet
Commenter

Description

J'ai vu qu'il en existait deja sur se site, mais je propose mon alternative au snake. Très simple. Avec sauvegarde de score.

Source / Exemple : 


'________________________________________________________________'
'Nom: David Chardonnens                                          '
'But: Snake pour NeverHappy (projet MAS6)                        '
'________________________________________________________________'

Option Explicit
Dim PathOfTrue, Begin As Boolean
Dim strTemp, Direction As String
Dim max, speed, randomL, randomT, i, quit As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case 49
'Dès que l'on appui sur la touche 1 le temps vaut 30
            speed = 30
            Call FixedSpeed
        Case 50
'Dès que l'on appui sur la touche 2 le temps vaut 70
            speed = 70
            Call FixedSpeed
        Case 51
'Dès que l'on appui sur la touche 3 le temps vaut 140
            speed = 140
            Call FixedSpeed
        Case 32
'La touche espace met en pause tout les timers en sauvegardant le timer activé
            timDirection.Enabled = False
            Call MsgBox("Pause", vbInformation, "Never|Snake")
            timDirection.Enabled = True
        Case 27
'La touche excape mets en pause et sauvegarde le dernier timer activé
            timDirection.Enabled = False
            If MsgBox("Voulez-vous vraiment quitter?", vbOKCancel, "Never|Snake") = vbOK Then
                End
            Else
                timDirection.Enabled = True
            End If
    
'Dès que l'on appui sur une touche fléchées, on sauvegarde l'ancienne valeur est l'on active le timer correspondant
        Case 37
            If Direction <> "Right" Then
                Direction = "Left"
            End If
        Case 38
            If Direction <> "Down" Then
                Direction = "Up"
            End If
        Case 39
            If Direction <> "Left" Then
                Direction = "Right"
            End If
        Case 40
            If Direction <> "Up" Then
                Direction = "Down"
            End If
'Dès que l'on appuis sur une touche numérique on retaille la fenetre
        Case 52 To 57
            timDirection.Enabled = False
            frmGame.Width = CInt(KeyCode - 52) * 360 + 2400
            Call Form_Resize
            Call MsgBox("Vous avez changer de taille!", vbInformation, "NeverHappy | Snake")
            timDirection.Enabled = True
    End Select
End Sub

Private Sub Form_Load()
'On prends la taille du Form si c'est la premiere ouverture, est on dit que begin est true
    If frmGame.Height <> frmGame.Width Then
        Call Form_Resize
        Begin = True
    End If
    
'On commence a droite
    Direction = "Right"
    
'On place le score a la limite du terrain
    lblScore.Left = frmGame.Width - lblScore.Width
    
'On déclare la valeur de base
    speed = 70
    Call FixedSpeed
    
'On ouvre le fichier que le premier demarrage
    If Begin Then
'Avant tout on crée le fichier de score si il n'existe pas
        strTemp = "Le " + CStr(Date) + "   " + CStr(Time)
        Open "ScoreSnake.nev" For Append As #1
            Write #1, strTemp
        Close #1
        Begin = False
    End If
    
'On place la pomme aléatoirement
    Randomize
    randomL = CInt((((Rnd * 100) + 1) * max))
    randomT = CInt((((Rnd * 100) + 1) * max))
    shpApple(0).Left = randomL - (randomL Mod 120)
    shpApple(0).Top = randomT
    shpApple(0).Top = shpApple(shpApple.Count - 1).Left - (shpApple(shpApple.Count - 1).Left Mod 120)
End Sub

Private Sub FixedSpeed()
'Tout les timers ont la valeur de speed comme interval
    timDirection.Interval = speed
End Sub

Private Sub Form_Resize()
'On prends la taille du Form
    frmSnake.Height = frmGame.Width
    frmSnake.Width = frmGame.Width
    frmGame.Height = frmGame.Width
    max = frmSnake.Height / 120
    
'On place le score a la limite du terrain
    lblScore.Left = frmGame.Width - lblScore.Width
End Sub

Private Sub timDirection_Timer()
'Si il n'y a pas qu'un seul cube de seprent on cherche ceux qui doivent suivre
    If shpSnake.Count <> 1 Then
        Call SnakeBehind
    End If
    
'On deplace le premier des cubes de serpent et si on arrive au bout du form
    If Direction = "Up" Then
        shpSnake(0).Top = shpSnake(0).Top - 120
        If shpSnake(0).Top < 0 Then
            Call Dead
        End If
    ElseIf Direction = "Down" Then
        shpSnake(0).Top = shpSnake(0).Top + 120
        If shpSnake(0).Top > frmGame.Height - shpSnake(0).Height Then
            Call Dead
        End If
    ElseIf Direction = "Left" Then
        shpSnake(0).Left = shpSnake(0).Left - 120
        If shpSnake(0).Left < 0 Then
            Call Dead
        End If
    ElseIf Direction = "Right" Then
        shpSnake(0).Left = shpSnake(0).Left + 120
        If shpSnake(0).Left > frmGame.Width - shpSnake(0).Width Then
            Call Dead
        End If
    End If
    
'On appel la detection de collision
    Call detection
    
'PathOfTrue est la voix qui permet d'activer une autre direction
    PathOfTrue = True
End Sub

Private Sub detection()
'Si onn touche une pomme, on appel la nouvelle pomme
    If (shpSnake(0).Left = shpApple(shpApple.Count - 1).Left) And (shpSnake(0).Top = shpApple(shpApple.Count - 1).Top) Then
        Call EatApple
    End If
    
'Si on se touche on appel la fin du jeu
    For i = 1 To shpSnake.Count - 1
        If (shpSnake(0).Left = shpSnake(i).Left) And (shpSnake(0).Top = shpSnake(i).Top) Then
            Call Dead
            Exit For
        End If
    Next i
End Sub

Private Sub SnakeBehind()
'Le dernier cube du serpent suis son prédécéceur
    For i = shpSnake.Count - 1 To 1 Step -1
        shpSnake(i).Left = shpSnake(i - 1).Left
        shpSnake(i).Top = shpSnake(i - 1).Top
    Next i
End Sub

Private Sub EatApple()
'On mets en un valeur en random, jusqu'au bout du Form
    Randomize
    randomL = CInt((((Rnd * 100) + 1) * max))
    Randomize
    randomT = CInt((((Rnd * 100) + 1) * max))
    
'On appel une nouvelle pomme
    Load shpApple(shpApple.Count)
    shpApple(shpApple.Count - 1).Visible = True
    shpApple(shpApple.Count - 2).Visible = False
    shpApple(shpApple.Count - 1).Left = randomL - (randomL Mod 120)
'Si la pomme est déplace la pomme si elle est sur un de nos cubes
    For i = 0 To shpSnake(shpSnake.Count - 1)
        If (shpApple(shpApple.Count - 1).Left = shpSnake(i).Left) And (shpApple(shpApple.Count - 1).Top = shpSnake(i).Top) Then
            shpApple(shpApple.Count - 1).Left = shpApple(shpApple.Count - 1) + 120
        End If
    Next i
'On déplace la pomme si elle est au bout du terrain
    If shpApple(shpApple.Count - 1).Left Mod 120 <> 0 Then
        shpApple(shpApple.Count - 1).Left = shpApple(shpApple.Count - 1).Left - (shpApple(shpApple.Count - 1).Left Mod 120)
    End If
    
'On place la pomme sur le terrain
    shpApple(shpApple.Count - 1).Top = randomT
    shpApple(shpApple.Count - 1).Top = shpApple(shpApple.Count - 1).Left - (shpApple(shpApple.Count - 1).Left Mod 120)
'Si la pomme est sur un de nos cubes on la déplace
    For i = 0 To shpSnake(shpSnake.Count - 1)
        If (shpApple(shpApple.Count - 1).Left = shpSnake(i).Left) And (shpApple(shpApple.Count - 1).Top = shpSnake(i).Top) Then
            shpApple(shpApple.Count - 1).Top = shpApple(shpApple.Count - 1) + 120
        End If
    Next i
'On déplace la pomme si elle est au bout du terrain
    If shpApple(shpApple.Count - 1).Top Mod 120 <> 0 Then
        shpApple(shpApple.Count - 1).Top = shpApple(shpApple.Count - 1).Top - (shpApple(shpApple.Count - 1).Top Mod 120)
    End If
    
'On mets a jour le score
    lblScore.Caption = CInt(lblScore.Caption) + 1
    
'On Charge un nouveau cube
    Load shpSnake(shpSnake.Count)
    shpSnake(shpSnake.Count - 1).Visible = True
'On déplace le cube juste derriere son prédécéceur pour eviter une collision au prochain mouvement
    If Direction = "Down" Or Direction = "Up" Then
        If Direction = "Up" Then
            shpSnake(shpSnake.Count - 1).Top = shpSnake(shpSnake.Count - 1).Top + 120
        Else
            shpSnake(shpSnake.Count - 1).Top = shpSnake(shpSnake.Count - 1).Top - 120
        End If
    Else
        If Direction = "Left" Then
            shpSnake(shpSnake.Count - 1).Left = shpSnake(shpSnake.Count - 1).Left + 120
        Else
            shpSnake(shpSnake.Count - 1).Left = shpSnake(shpSnake.Count - 1).Left - 120
        End If
    End If
End Sub

Private Sub Dead()
'On rends tout les timer en faux pour eviter que l'utilisateur meurt plusieurs fois
    timDirection.Enabled = False
    
'On enregistre le score
    Open "ScoreSnake.nev" For Append As #1
        Write #1, lblScore.Caption
    Close #1
    
'On signial a l'utilisateur qu'il a perdu, son score, et on quitte le jeu via l'interface Never
    If MsgBox("Vous avez perdu!" + vbCrLf + "Vous avez mangé " + Str(shpApple.Count - 1) + " pommes" + vbCrLf + "Voulez-vous quitter?", vbYesNo, "Never|Snake") = vbYes Then
        End
    End If
    
'On décharge tout se qui aurait pu etre charger durant la partie
    If shpApple.Count > 1 Then
        For i = 1 To shpApple.Count - 1
            Unload shpApple(i)
        Next i
        For i = 1 To shpSnake.Count - 1
            Unload shpSnake(i)
        Next i
    End If
    
'On remet en le serpent
    shpSnake(0).Left = 0
    shpSnake(0).Top = 0
    Direction = "Right"
    timDirection = True
    
'On rend visible la première pomme
    shpApple(0).Visible = True
    
'On affiche le score
    lblHide.Caption = ""
    Open "ScoreSnake.nev" For Input As #1
        While Not EOF(1)
            Input #1, strTemp
            If lblHide.Caption <> "" Or lblHide.Caption <> " " Then
                lblHide.Caption = lblHide.Caption + vbCrLf + strTemp
            Else
                lblHide.Caption = strTemp
            End If
        Wend
    Close #1
    Call MsgBox("Score sauvé jusqu'à aujourd'hui: " + vbCrLf + lblHide.Caption, vbInformation, "NeverHappy | Snake")
    
'On remet le score a 0
    lblScore.Caption = "0"
End Sub

Conclusion :


Ce jeu fit partie dûn projet que j'ai voulut faire pour mes cours.
Si vous trouvez un bug je le prends volontier pour le corrigé.
Télécharger le projet

Codes Sources

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 (gloomy64)