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é.
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.