JEU DU CISEAUX

Imports System.IO
Public Class Form1
    ' ouvrir les fichiers dans leur programme 
    'C'est nécessaire pour ouvrir n'importe quel dossier, il déclare ce qui va être exécuté plus tard 
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer
    Private m_ControlCount As Int16 = 0 'image dans bouton 
    Dim ChoixJoueur As Long ' Jeu
    'Label défilant
    Dim Address As String
    Dim response As DialogResult
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Randomize()
        btnciseaux.Enabled = False 'boutons inactifs à l'ouverture
        btnfeuille.Enabled = False
        btnpierre.Enabled = False
        btnpuits.Enabled = False
        btnstart.Enabled = False
    End Sub
#Region "Jeu"
    Sub Choix(ByVal Valeur As Long)
        ChoixJoueur = Valeur
        PictureBox1.Image = Nothing
    End Sub
    Private Sub btnciseaux_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnciseaux.Click
        Call Choix(1)
        Startjeu()
        PictureBox2.Image = My.Resources.ciseaux
    End Sub

    Private Sub btnfeuille_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnfeuille.Click
        Call Choix(2)
        Startjeu()
        PictureBox2.Image = My.Resources.feuille
    End Sub

    Private Sub btnpierre_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnpierre.Click
        Call Choix(3)
        Startjeu()
        PictureBox2.Image = My.Resources.pierre
    End Sub

    Private Sub btnpuits_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnpuits.Click
        Call Choix(4)
        Startjeu()
        PictureBox2.Image = My.Resources.puits
    End Sub

    Sub Startjeu()

        'Ordinateur
        Dim ChoixOrdi As Long
        ChoixOrdi = Int(4 * Rnd() + 1)

        Select Case ChoixOrdi
            Case 1
                PictureBox1.Image = My.Resources.ciseaux
            Case 2
                PictureBox1.Image = My.Resources.feuille
            Case 3
                PictureBox1.Image = My.Resources.pierre
            Case 4
                PictureBox1.Image = My.Resources.puits
        End Select

        'Résultat
        If ChoixJoueur = 1 And ChoixOrdi = 2 Then
            Label2.Text = "Gagné, les ciseaux coupent la feuille"
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = 2 And ChoixOrdi = 4 Then
            Label2.Text = "Gagné, la feuille bouche le puits"
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = 2 And ChoixOrdi = 3 Then
            Label2.Text = "Gagné, la feuille enveloppe la pierre "
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = 3 And ChoixOrdi = 1 Then
            Label2.Text = "Gagné, la pierre émousse les ciseaux"
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = 4 And ChoixOrdi = 3 Then
            Label2.Text = "Gagné, la pierre tombe dans le puits"
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = 4 And ChoixOrdi = 1 Then
            Label2.Text = "Gagné, les ciseaux tombent dans le puits"
            Label1.Text = CStr(CDbl(Label1.Text) + 1)
        ElseIf ChoixJoueur = ChoixOrdi Then
            Label2.Text = "Egalité"
        Else
            Label2.Text = "Perdu"
            Label3.Text = CStr(CDbl(Label3.Text) + 1)
        End If

    End Sub
#End Region
#Region "Chronométrage"
    'Chrono
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Label7.Text = CStr(CDbl(Label7.Text) + 1)
    End Sub
    ' On arrête le chrono
    Private Sub Label7_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label7.TextChanged
        If Label7.Text = ComboBox1.Text Then
            Timer1.Enabled = False
            tmrImage.Stop()
            btnciseaux.Enabled = False 'boutons inactifs
            btnfeuille.Enabled = False
            btnpierre.Enabled = False
            btnpuits.Enabled = False
            timdef.Enabled = False
            Label9.Text = ("Terminé,cliquez sur Start pour rejouer")
            My.Computer.Audio.Play(Application.StartupPath & "\ringin.wav", AudioPlayMode.Background) 'Mettre le fichier wav dans le dossier 'Debug'
            Label7.Text = "0"
        End If

    End Sub

    ' On fait démarrer le chrono
    Private Sub btnstart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnstart.Click
        Timer1.Enabled = True
        btnciseaux.Enabled = True 'boutons actifs
        btnfeuille.Enabled = True
        btnpierre.Enabled = True
        btnpuits.Enabled = True
        tmrImage.Start()
        Label1.Text = "0"
        Label2.Text = ""
        Label3.Text = "0"
        Label9.Text = ""
        'On démarre le label défilant
        txtStart.Text = StrConv(txtStart.Text, VbStrConv.ProperCase)
        If Trim(txtStart.Text) = "" Then
            Address = "et Bonjour"
        Else
            Address = txtStart.Text
        End If
        lblName.Text = Address
        lblMessage.Text = "  Bienvenue  " + Address & "  et bon jeu.  "
        timdef.Enabled = True
    End Sub

    Private Sub tmrImage_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrImage.Tick
        ' Mettre l'image dans le bouton
        btnstart.Image = imgList.Images(m_ControlCount)
        'On fait défiler les images 
        m_ControlCount = (m_ControlCount + 1) Mod imgList.Images.Count
    End Sub
#End Region
#Region "Résultats"
    Private Sub btnsave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnsave.Click
        Dim time As String 'date et heure
        SaveFileDialog1.InitialDirectory = Application.StartupPath & "\Scores\"
        SaveFileDialog1.Filter = "Fichier TEXTE(*.txt)|*.txt"
        SaveFileDialog1.FilterIndex = 0

        If SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
          
            If File.Exists(SaveFileDialog1.FileName) Then File.Delete(SaveFileDialog1.FileName)
            'Si le fichier existe deja il est supprimé.
            Dim Fichier As IO.StreamWriter = File.AppendText(SaveFileDialog1.FileName)
            Dim Chaine As String = ""
            time = CStr(Now) 'on inscrit la date et l'heure
            Chaine = time & vbNewLine & "Résultats en " & ComboBox1.Text & " secondes" & vbNewLine & Label5.Text & ": " & Label1.Text & vbNewLine & "Ordinateur: " & Label3.Text
            'La chaine est ecrite dans le fichier.
            Fichier.Write(Chaine)
            Fichier.Close()
        End If
    End Sub

    ' Ouvrir programme par défaut 
    Public Function OpenFile(ByRef File As String, Optional ByRef Parametres As String = "") As Object
        ShellExecute(Handle.ToInt32, "Open", File, Parametres, My.Application.Info.DirectoryPath, 1)
        OpenFile = 1
    End Function
    Dim fichier As String
    Private Sub btnresult_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnresult.Click
        'on cherche le chemin
        Dim dlg As New OpenFileDialog
        If dlg.ShowDialog = Windows.Forms.DialogResult.OK Then
            fichier = dlg.FileName
        End If
        Try
            'Ouvre le fichier dans son programme par défaut
            OpenFile(fichier)
        Catch ex As Exception
        End Try
    End Sub
#End Region
#Region "Label défilant"
    Private Sub timdef_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timdef.Tick
        'créez un texte défilant dans la boîte de label
        lblMessage.Text = Mid(lblMessage.Text, 2, lblMessage.Text.Length - 1) & Mid(lblMessage.Text, 1, 1)

    End Sub
    Private Sub txtStart_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtStart.TextChanged
        btnstart.Enabled = True
        Label5.Text = txtStart.Text
        If txtStart.Text = "" Then
            txtStart.Text = "Joueur"
       End If
        If txtStart.TextLength > 9 Then
            response = MessageBox.Show("Votre nom est trop long, faites-le moins de 9 lettres. S'il vous plaît!", "Nom top long", _
            MessageBoxButtons.OK)
            If response = Windows.Forms.DialogResult.OK Then
                txtStart.Focus()
                txtStart.Text = ""
            End If
            Exit Sub
        End If
    End Sub
#End Region
End Class

Télécharger le zip

07 août 2008 18:50:17 :

J'ai simplifié la source avec des boutons qui agissent directement.

08 août 2008 11:13:55 :

Suppression de la répétition "égalité" en VB2005.Restructuration du code en VBA Excel grâce à l'aide précieuse de US_30 que je remercie, j'ai seulement changé les boutonsoptions par des boutons comme dans le VB2005.

08 août 2008 15:27:18 :

Rectifications dans les résultats

11 août 2008 16:16:32 :

Chronométrages des parties avec choix dans un comboBox. Animation du bouton "Start" pendant le cours du jeu.

12 août 2008 14:23:24 :

Ajout du chronométrage en VBA. La difficulté se trouve dans le fait qu'il n'y a pas de Timer en VBA, donc il faut utiliser un module.Le choix est fait comme en VB2005 avec un comboBox.

13 août 2008 08:19:14 :

En VBA Excel: Affichage toutes les 5 secondes de la durée du jeu.

13 août 2008 11:16:53 :

Problème résolue pour les erreurs de saisies en VBA: MsgBox "Erreur de saisie" Application.OnTime Now + TimeValue("00:00:01"), "TimerOff" on régle sur 1 seconde, sinon sur 0 seconde cela crée un bug.

16 août 2008 16:30:39 :

On peut enregistrer les résultats des parties dans un fichier txt, avec les temps ainsi que la date et aussi un label défilant avec votre nom pendant la durée de la partie.