Batch Index du Forum
S’enregistrerRechercherFAQMembresGroupesConnexion
Répondre au sujet Page 1 sur 2
Aller à la page: 1, 2  >
[VB.net] Snake (jeu du serpent)
Auteur Message
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Bonjour,
Je reviens avec un nouveau projet en VB.NET, il s'agit d'un Snake cette fois.

OS de développement : Windows 7 Ultimate 32 bits.
OS compatible : Ceux sous windows possédant le framework 4.0 ou supérieur.

Code:
Imports System.Runtime.InteropServices.Marshal

Public Class Form1
    'Déclaration des variables publiques (peuvent être modifiés n'importe où dans le code
    Public ClassIni As New ComINI
    Public j As Integer = 3
    Public temps As Integer = 0
    Public tempsDiff As Integer = 5
    Public Score As Integer = 0
    Public Creation As Boolean = False
    Public Commencer As Boolean
    Public Action As Boolean
    Public progressive As Boolean = False
    Public difficulté As String = "facile"
    Public Compteur As Integer = 0
    Public Bonus As Boolean = False
    Private Direction As Byte = 2

    Enum Directions
        Gauche = 1
        Droite = 2
        Haut = 3
        Bas = 4
    End Enum

    Private Sub Form1_KeyDown(ByVal sender As System.Object, ByVal e As KeyEventArgs) Handles Me.KeyDown 'Permet la gestion des touches et donc des
        If Commencer And Action Then                                                                     'directions du serpent
            If e.KeyCode = Keys.Right And Not Direction = 1 Then
                Direction = 2
                PictureBox1.Image = My.Resources.TêteSerpentDroite
                Action = False
            ElseIf e.KeyCode = Keys.Left And Not Direction = 2 Then
                Direction = 1
                PictureBox1.Image = My.Resources.TêteSerpentGauche
                Action = False
            ElseIf e.KeyCode = Keys.Up And Not Direction = 4 Then
                Direction = 3
                PictureBox1.Image = My.Resources.TêteSerpentHaut
                Action = False
            ElseIf e.KeyCode = Keys.Down And Not Direction = 3 Then
                Direction = 4
                PictureBox1.Image = My.Resources.TêteSerpentBas
                Action = False
            End If
        End If
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick 'Avancement du serpent
        Dim i As Integer
        i = Me.PanelJeu.Controls.Count - 1
        While i > -1      'Boucle pour listerles pictureBox du serpent
            If Not PanelJeu.Controls.Item(i) Is PictureBox1 Then
                PanelJeu.Controls.Item(i).Location = PanelJeu.Controls.Item(i - 1).Location
                If Not PanelJeu.Controls.Item(i) Is PictureBox2 Then
                    If PanelJeu.Controls.Item(i).Location = PictureBox1.Location Then 'Si il y a colision entre la tête et une partie du corps,
                        fin()                                                         'on quitte le timer
                        Exit Sub
                    End If
                End If
            End If
            If PictureBox1.Location = PictureBoxMiam.Location Then 'Si le serpent mange
                j = j + 1
                Compteur = Compteur + 1
                Creation = True
                Dim bon As Boolean = False
                While Not bon             'Boucle pour raplacer la nourriture en évitant qu'elle apparaisse sur le serpent
                    Dim a As Integer = 1
                    Dim b As Integer = 1
                    While a Mod 15 <> 0
                        Randomize()
                        a = Int(4500 * Rnd()) \ 15
                        While b Mod 15 <> 0
                            b = Int(4500 * Rnd()) \ 15
                        End While
                    End While
                    PictureBoxMiam.Location = New Point(a, b)
                    For Each PictureBox In PanelJeu.Controls
                        If PictureBox.location = PictureBoxMiam.Location Then
                            bon = False
                            Exit For
                        Else
                            bon = True
                        End If
                    Next
                End While
            End If
            If PictureBox1.Location = PictureBoxBonus.Location Then
                Creation = True
                Bonus = True
                j = j + 1
                TimerBonus.Enabled = False
                Me.PictureBoxBonus.Visible = False
            End If
            i = i - 1
        End While
        If Direction = 2 Then  'on gère les directions
            Me.PictureBox1.Location = New Point(Me.PictureBox1.Location.X + 15, Me.PictureBox1.Location.Y)
        ElseIf Direction = 1 Then
            Me.PictureBox1.Location = New Point(Me.PictureBox1.Location.X - 15, Me.PictureBox1.Location.Y)
        ElseIf Direction = 3 Then
            Me.PictureBox1.Location = New Point(Me.PictureBox1.Location.X, Me.PictureBox1.Location.Y - 15)
        ElseIf Direction = 4 Then
            Me.PictureBox1.Location = New Point(Me.PictureBox1.Location.X, Me.PictureBox1.Location.Y + 15)
        End If
        If Creation Then 'Création d'une partie du corps si le serpent a mangé
            Dim pictureBoxCorps As New PictureBox
            pictureBoxCorps.Name = "PictureBox" & j
            pictureBoxCorps.Size = New Size(15, 15)
            pictureBoxCorps.Image = My.Resources.BouleCorps
            pictureBoxCorps.Location = New Point(-15, -15)
            PanelJeu.Controls.Add(pictureBoxCorps)
            Creation = False
            Score = Score + 1
            If progressive Then        'Si difficulté progressive, on diminue l'interval du timer tous les 10 points
                If Score Mod 10 = 0 And Not Timer1.Interval < 51 Then
                    Timer1.Interval = Timer1.Interval - 25
                End If
            End If
            If Bonus Then
                Score = Score + 4
                Bonus = False
            End If
            Me.Label2.Text = Score & " points"
        End If
        If Compteur = 7 Then
            Compteur = 0
            Dim bon As Boolean = False
            While Not bon             'Boucle pour raplacer le bonus en évitant qu'elle apparaisse sur le serpent
                Dim a As Integer = 1
                Dim b As Integer = 1
                While a Mod 15 <> 0
                    Randomize()
                    a = Int(4500 * Rnd()) \ 15
                    While b Mod 15 <> 0
                        b = Int(4500 * Rnd()) \ 15
                    End While
                End While
                PictureBoxBonus.Location = New Point(a, b)
                For Each PictureBox In PanelJeu.Controls
                    If PictureBox.location = PictureBoxBonus.Location Then
                        bon = False
                        Exit For
                    Else
                        bon = True
                    End If
                Next
            End While
            Me.PictureBoxBonus.Visible = True
            temps = 0
            TimerBonus.Enabled = True
        End If
        If temps = tempsDiff Then
            Me.PictureBoxBonus.Location = New Point(-15, 0)
            Me.PictureBoxBonus.Visible = False
            TimerBonus.Enabled = False
        End If
        If PictureBox1.Location.X < 0 Or PictureBox1.Location.X > 285 Or PictureBox1.Location.Y < 0 Or PictureBox1.Location.Y > 285 Then
            fin()       'Exécuté si on a tapé un mur
        End If
        Action = True
    End Sub

    Sub fin() 'se produit lorsqu'on perd et demande de rejouer
        Timer1.Enabled = False
        Dim Fscore As Integer
        If ClassIni.ExisteSection(Application.StartupPath & "\score", "meilleur") And Not ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) = "" Then
            Fscore = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté)
        Else
            fscore = 0
        End If
        If Score > Fscore Then
            ClassIni.SetCle(Application.StartupPath & "\score", "meilleur", difficulté, Score)
            If MsgBox("Fin de la partie." & Chr(13) & Chr(13) & "Votre score est de " & Score & " points" & Chr(13) & "Nouveau meilleur score !" & Chr(13) & Chr(13) & Chr(13) & "Voulez-vous rejouer ?", 4, "Terminé !") = vbYes Then
                Rejouer()
            Else
                Me.Close()
            End If
        Else
            If MsgBox("Fin de la partie." & Chr(13) & Chr(13) & "Votre score est de " & Score & " points" & Chr(13) & Chr(13) & Chr(13) & "Voulez-vous rejouer ?", 4, "Terminé !") = vbYes Then
                Rejouer()
            Else
                Me.Close()
            End If
        End If
    End Sub

    Sub Rejouer() 'remise de la fenetre à 0 si on veut rejouer
        Dim i As Integer = Me.PanelJeu.Controls.Count - 1
        While i > -1
            If Not PanelJeu.Controls.Item(i) Is PictureBox1 And Not PanelJeu.Controls.Item(i) Is PictureBox2 And Not PanelJeu.Controls.Item(i) Is PictureBox3 Then
                PanelJeu.Controls.Remove(PanelJeu.Controls.Item(i))
            End If
            i = i - 1
        End While
        PanelJeu.Visible = False
        PictureBoxMiam.Visible = False
        Me.RadioButtonFacile.Visible = False
        Me.RadioButtonMoyen.Visible = False
        Me.RadioButtonDifficile.Visible = False
        Me.RadioButtonProgress.Visible = False
        Me.Button1.Visible = False
        Me.Label1.Visible = False
        Me.Label2.Visible = False
        Me.Label4.Visible = False
        Me.Label5.Visible = False
        Direction = 2
        Score = 0
        Compteur = 0
        Me.InitializeComponent()
        Commencer = False
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'initialisation pour commencer
        Me.RadioButtonFacile.Enabled = False
        Me.RadioButtonMoyen.Enabled = False
        Me.RadioButtonDifficile.Enabled = False
        Me.RadioButtonProgress.Enabled = False
        Me.Button1.Enabled = False
        Timer1.Enabled = True
        Dim a As Integer = 1
        Dim b As Integer = 1
        While a Mod 15 <> 0
            Randomize()
            a = Int(4500 * Rnd()) \ 15
            While b Mod 15 <> 0
                b = Int(4500 * Rnd()) \ 15
            End While
        End While
        PictureBoxMiam.Location = New Point(a, b)
        Me.PictureBoxMiam.BringToFront()
        Commencer = True
    End Sub

    Private Sub RadioButtonFacile_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButtonFacile.CheckedChanged
        Me.Timer1.Interval = 200
        difficulté = "facile"
        tempsDiff = 5
        Me.Label5.Text = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) & " points"
    End Sub

    Private Sub RadioButtonMoyen_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButtonMoyen.CheckedChanged
        Me.Timer1.Interval = 150
        difficulté = "moyen"
        tempsDiff = 4
        Me.Label5.Text = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) & " points"
    End Sub

    Private Sub RadioButtonDifficile_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButtonDifficile.CheckedChanged
        Me.Timer1.Interval = 100
        difficulté = "difficile"
        tempsDiff = 3
        Me.Label5.Text = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) & " points"
    End Sub

    Private Sub RadioButtonProgress_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButtonProgress.CheckedChanged
        Me.Timer1.Interval = 200
        progressive = True
        difficulté = "progressive"
        tempsDiff = 3
        Me.Label5.Text = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) & " points"
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Label5.Text = ClassIni.GetCle(Application.StartupPath & "\score", "meilleur", difficulté) & " points"
    End Sub

    Private Sub TimerBonus_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimerBonus.Tick
        temps = temps + 1
    End Sub
End Class

Public Class ComINI

    Private Declare Function GetPrivateProfileSection Lib "kernel32.dll" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedBuffer As IntPtr, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function GetPrivateProfileSectionNames Lib "kernel32.dll" Alias "GetPrivateProfileSectionNamesA" (ByVal lpszReturnBuffer As IntPtr, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedBuffer As IntPtr, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    Private Declare Function WritePrivateProfileSection Lib "kernel32.dll" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
    Private Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Long




    'Retourne un booléen indiquant l'existance ou non d'une section
    Public Function ExisteSection(ByVal File As String, ByVal Section As String) As Boolean
        Dim PtrCh As IntPtr
        Dim Lng As Integer

        PtrCh = StringToHGlobalAnsi(New String(vbNullChar, 1024))
        Lng = GetPrivateProfileSection(Section, PtrCh, 1024, File)

        Return Lng
    End Function

    'Retourne une collection contenant l'ensemble des sections du fichier "File"
    Public Function GetAllSections(ByVal File As String) As Collection
        Dim PtrCh As IntPtr
        Dim Sections As Collection
        Dim I, Lng As Integer
        Dim Chaine, SChaine As String

        PtrCh = StringToHGlobalAnsi(New String(vbNullChar, 1024))
        Lng = GetPrivateProfileSectionNames(PtrCh, 1024, File)
        Chaine = PtrToStringAnsi(PtrCh, Lng)
        FreeHGlobal(PtrCh)

        Sections = New Collection
        SChaine = ""
        For I = 0 To Lng - 1
            If Chaine.Chars(I) = vbNullChar Then
                Sections.Add(SChaine)
                SChaine = ""
            Else
                SChaine = SChaine & Chaine.Chars(I)
            End If
        Next
        GetAllSections = Sections
        Sections = Nothing
    End Function

    'Retourne une collection contenant l'ensemble des clés de la section "Section" du fichier "File"
    Public Function GetSectionCles(ByVal File As String, ByVal Section As String) As Collection
        Dim PtrCh As IntPtr
        Dim Cles As Collection
        Dim I, Lng As Integer
        Dim Chaine, SChaine As String

        PtrCh = StringToHGlobalAnsi(New String(vbNullChar, 1024))
        Lng = GetPrivateProfileSection(Section, PtrCh, 1024, File)
        Chaine = PtrToStringAnsi(PtrCh, Lng)
        FreeHGlobal(PtrCh)

        Cles = New Collection
        SChaine = ""
        For I = 0 To Lng - 1
            If Chaine.Chars(I) = vbNullChar Then
                Cles.Add(SChaine)
                SChaine = ""
            Else
                SChaine = SChaine & Chaine.Chars(I)
            End If
        Next
        GetSectionCles = Cles
        Cles = Nothing
    End Function

    'Retourne la valeur de la clé "Cle" de la section "Section" du fichier "File"
    Public Function GetCle(ByVal File As String, ByVal Section As String, ByVal Cle As String) As String
        Dim PtrCh As IntPtr
        Dim Lng As Integer
        Dim Chaine As String

        PtrCh = StringToHGlobalAnsi(New String(vbNullChar, 1024))
        Lng = GetPrivateProfileString(Section, Cle, "", PtrCh, 255, File)
        Chaine = PtrToStringAnsi(PtrCh, Lng)
        FreeHGlobal(PtrCh)

        GetCle = Chaine
    End Function


    'Insère une section dans le fichier "File"
    Public Function SetSection(ByVal File As String, ByVal Section As String, ByVal Valeur As String) As Boolean
        SetSection = WritePrivateProfileSection(Section, Valeur, File)
    End Function

    'Insère la clé "Cle" dans la section "Section" du fichier "File"
    Public Function SetCle(ByVal File As String, ByVal Section As String, ByVal Cle As String, ByVal Valeur As String) As Boolean
        SetCle = WritePrivateProfileString(Section, Cle, Valeur, File)
    End Function


    'Efface toute les clés de la section "Section"
    Public Function DelSection(ByVal File As String, ByVal Section As String) As Boolean
        DelSection = WritePrivateProfileSection(Section, "", File)
    End Function

    'Efface la valeur de la clé "Cle" de la section "Section"
    Public Function DelCle(ByVal File As String, ByVal Section As String, ByVal Cle As String) As Boolean
        DelCle = WritePrivateProfileString(Section, Cle, "", File)
    End Function

End Class


Screen :



Et un lien de téléchargement pour terminer : http://www.box.net/shared/ptbfdxxaqk



Dernière édition par Tufanik le Lun 28 Fév 2011 - 14:52; édité 4 fois
Message Publicité 
PublicitéSupprimer les publicités ?


Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Coucou
Excellent travail il est très réussi.
Dommage que le code ne soit pas commenté pour les non initiés.




______________________________________________________
Faites paraitre votre batch sur BatchClipboard
Visiter le site web du posteur
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Bonjour Laddy, j'ai ajouté des commentaires.



Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Bien jouer ! Wink



Répondre en citant
Message Re: [VB.net] Snake (jeu du serpent) 
Hello

GG Okay
Vraiment pas mal ^^

par contre:
Code:
Public direction As String = "droite"

Je rêve ou tu as mis la direction dans une chaine Shocked ç'aurait pas été plus intéligent de la stocker dans un integer Embarassed

@+




______________________________________________________
--
> Que pensez vous de l'ajout du repertoire point dans $PATH ?
Ma version de troll 18.0.32 beta 3 vient de me faire un core dump.
-+- SE in Guide du Linuxien Pervers : Bien développer son troll -+-

[Dos9]
Visiter le site web du posteur Skype
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
pourquoi mettre ça dans un integer ?

Propose ta méthode Smile



Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
J'ai pensé ça aussi. :p Un truc du genre :

Code:
Private Direction As Integer = Directions.Gauche

Enum Directions
    Gauche = 1
    Droite = 2
    Haut = 3
    Bas = 4
End Enum




Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Hey, ça a l'air bien ce programme, je me réjouis de le tester sur mon ordi. Okay

Dommage qu'on ne puisse pas vraiment faire ça en autoit...




______________________________________________________
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
iLgend a écrit:
J'ai pensé ça aussi. :p Un truc du genre :

Code:
Private Direction As Integer = Directions.Gauche

Enum Directions
    Gauche = 1
    Droite = 2
    Haut = 3
    Bas = 4
End Enum



Shocked Je connaissais pas du tout ça, je vais regarder ce que je peux en faire.

Enum Direction
...
End enum
Se déclare t-il dans une fonction ou juste dans la classe Form1 ?


PS : Une petite question pour les graphistes aussi, comment fait t-on une icône (dimensions, couleurs, transparence ...) pour un programme ? Je fais les miennes avec Photofiltre mais lorsque je fais exporter en temps qu'icônes, le rendu dans la barre des tache ou sur le coin gauche de la fenêtre est toujours extrêmement moche et flouté.



Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Dans la classe. Wink



Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Hello!

Code:
Private Direction As Byte = Directions.Gauche

Enum Directions
    Gauche = 1
    Droite = 2
    Haut = 3
    Bas = 4
End Enum


Bah pareil, j'ai pensé à une énum comme l'a fait iLgend... ça permet d'économiser de la mémoire:
"gauche" ou "droite" prennent 7 octects en mémoire alors qu'un byte un seul... en plus, c'est plus long de comparer deux chaines que deux bytes

Tufanik a écrit:

PS : Une petite question pour les graphistes aussi, comment fait t-on une icône (dimensions, couleurs, transparence ...) pour un programme ? Je fais les miennes avec Photofiltre mais lorsque je fais exporter en temps qu'icônes, le rendu dans la barre des tache ou sur le coin gauche de la fenêtre est toujours extrêmement moche et flouté.


Il y a plein de logiciels pour cela (perso j'utilise icoFx) mais le problème c'est que la résolution maximum pour une icon est 256*256, quoique je suis pas sur qu'elles soient tolérées partout... donc c'est presque sur que ce serat flou... on peux rarement convertir un grande image en *.ico sans que le contenu see floute

@+




______________________________________________________
--
> Que pensez vous de l'ajout du repertoire point dans $PATH ?
Ma version de troll 18.0.32 beta 3 vient de me faire un core dump.
-+- SE in Guide du Linuxien Pervers : Bien développer son troll -+-

[Dos9]
Visiter le site web du posteur Skype
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Il est super ton Snake en VB.Net,
Bravo !




______________________________________________________
Dark Vador achète des slips en granit cosmique, d'où la difficulté de respirer.
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Merci pour vos commentaires. Nouvelle version.

v1.1 :
- Ajout d'une difficulté progressive
- Ajout de bonus
- Sauvegarde des scores selon la difficulté
- Ajout d'une icône
- Réorganisation de la fenêtre
- Changement de la gestion des directions






Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
Bonjour !

Pas mal, il manque une chose primordiale selon moi : la pause ! Smile

Sinon, j'ai ceci quand je perds (sortir de l'écran ou me mordre la queue)





______________________________________________________
Répondre en citant
Message [VB.net] Snake (jeu du serpent) 
OoOops ...

J'avais oublié de ré-up la version non bugué, c'est bon.



Message [VB.net] Snake (jeu du serpent) 


Montrer les messages depuis:
Répondre au sujet Page 1 sur 2
Aller à la page: 1, 2  >
  



Index | créer un forum | Forum gratuit d’entraide | Annuaire des forums gratuits | Signaler une violation | Conditions générales d'utilisation
Copyright 2008 - 2016 // Batch