Le mot le plus long en reseau

Télécharger le projet
Commenter

Description

bonjour,

Issus du jeu des chiffres et de lettres, je vous propose une version de jeu en réseau.

Il vous permettra d'affronter vos collègues au bureau ou votre famille sur le net

cela est mon premier programme vb en réseau j'attends vos avis

Source / Exemple : 


Option Explicit
Public i As Integer
Public compteurLettreBas As Integer
Public compteurJoueur As Integer
'Public temps As Date
'Public tempsInit As Date
Public compteurLettre As Integer
Public ancienEmplacementHaut As String
Public ancienneValeur As String
Public ancienEmplacementBas As String
Public haut As Integer
Public bas As Integer
Public temps As Integer
Public Joueur As Integer
Public compteurAutreJoueur As Integer
Public valider As Integer
Public valider2 As Integer
Public Ip As String

'permet l'alternance du choix des lettres

Public Sub fChoix()

       
    btConsonne.Enabled = True
    btVoyelle.Enabled = True
    
If Joueur = 1 Then
    'utilisation de l'operateur modulo
    If compteurLettre Mod 2 = 1 Then
    
    btConsonne.Enabled = False
    btVoyelle.Enabled = False
    
    End If
    

End If

If Joueur = 2 Then

    If compteurLettre Mod 2 = 0 Then
    
    btConsonne.Enabled = False
    btVoyelle.Enabled = False
     
    End If
    
    
End If

End Sub

'lancement de la parti

Public Sub fDebut()

btConsonne.Enabled = False
btConsonne.Visible = False
btVoyelle.Enabled = False
btVoyelle.Visible = False
btLancer.Enabled = True
Beep
temps = 45
Horloge.Enabled = True
'tempsInit = Now
End Sub

Private Sub btConsonne_Click()

'Declaration du tableau des consonnes
Dim tabConsonne As Variant
tabConsonne = Array("B", "C", "D", "F", "G", "H", "J", "K", "L", "M", "N", "P", "Q", "R", "S", "T", "V", "W", "X", "Z")

'Génération d'une consonne au hasard
Randomize
lblLettreHaut(compteurLettre).Caption = tabConsonne(Int((Rnd * 20)))
compteurLettre = compteurLettre + 1

Call fChoix

Reseau.SendData ("envoi " & lblLettreHaut(compteurLettre - 1).Caption & " " & compteurLettre)

'lancement de la parti
If compteurLettre = 9 Then
Call fDebut
End If

End Sub

Private Sub btVoyelle_Click()

'Declaration du tableau des voyelles
Dim tabVoyelle As Variant
tabVoyelle = Array("A", "E", "I", "O", "U", "Y")

'Génération d'une voyelle au hasard
Randomize
lblLettreHaut(compteurLettre).Caption = tabVoyelle(Int((Rnd * 6)))
compteurLettre = compteurLettre + 1

Call fChoix

Reseau.SendData ("envoi " & lblLettreHaut(compteurLettre - 1).Caption & " " & compteurLettre)

'lancement de la parti
If compteurLettre = 9 Then
Call fDebut
End If
End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)

    If haut = 1 Then
    lblLettreHaut(ancienEmplacementHaut).Caption = ancienneValeur
    End If

    If bas = 1 Then
    lblLettreBas(ancienEmplacementBas).Caption = ancienneValeur
    End If

    haut = 0
    bas = 0
    

End Sub

Private Sub Form_Load()
haut = 0
bas = 0
temps = 45
compteurLettre = 0
compteurLettreBas = 0
compteurJoueur = 0
compteurAutreJoueur = 0
valider = 0
valider2 = 0
Horloge.Enabled = False

For i = 0 To 8
lblLettreBas(i).Caption = ""
lblLettreHaut(i).Caption = ""
lblLettreHaut(i).Visible = True
Next

lblHorloge.Caption = ""
info.Caption = ""
btConsonne.Enabled = True
btConsonne.Visible = False
btVoyelle.Enabled = True
btVoyelle.Visible = False
btLancer.Enabled = False
btLancer.Visible = False

End Sub

'definition compteur
Private Sub Horloge_Timer()

If Horloge.Enabled = True Then
lblHorloge.Visible = True

temps = temps - 1
    If temps > 0 Then
    lblHorloge.Caption = temps
    btLancer.Enabled = False
    End If
    
    If temps = 0 Then
        
    lblHorloge.Caption = "C'est fini"
    btLancer.Enabled = True
    Horloge.Enabled = False
    Call mot
    
    End If

End If

End Sub
'assemblage et definition du mot trouver

Public Function mot() As String

mot = ""

For i = 0 To 8

    If Not lblLettreBas(i).Caption = "" Then
    mot = mot & lblLettreBas(i).Caption
    compteurJoueur = compteurJoueur + 1
    Else
    Exit For
    End If
    
Next

Reseau.SendData ("mot " & compteurJoueur & " " & mot)

End Function

' Lâcher au-dessus de lettre bas.
Private Sub lblLettreBas_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)

If haut = 1 Then

    If lblLettreBas(Index).Caption = "" Then
    
    lblLettreBas(Index).Caption = ancienneValeur
    lblLettreHaut(ancienEmplacementHaut).Caption = ""
    Else
    
    lblLettreHaut(ancienEmplacementHaut).Caption = ancienneValeur
    
    End If
    
End If

If bas = 1 Then
lblLettreBas(ancienEmplacementBas).Caption = lblLettreBas(Index).Caption
lblLettreBas(Index).Caption = ancienneValeur
End If

haut = 0
bas = 0

End Sub

' Décollage bas

Private Sub lblLettreBas_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If compteurLettre = 9 Then

    lblLettreBas(Index).Drag
    ancienEmplacementBas = Index
    ancienneValeur = lblLettreBas(Index).Caption
    bas = 1
    
End If
    
        
End Sub

'activation double clic pour les lettre du haut
Private Sub lblLettreHaut_DblClick(Index As Integer)

If compteurLettre = 9 Then

For i = 0 To 8

    If lblLettreBas(i) = "" Then
    lblLettreBas(i).Caption = lblLettreHaut(Index).Caption
    Exit For
    End If

Next

lblLettreHaut(Index).Caption = ""

End If

End Sub

' Lâcher au-dessus de lettre haut.
Private Sub lblLettreHaut_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)

If haut = 1 Then
lblLettreHaut(ancienEmplacementHaut).Caption = lblLettreHaut(Index).Caption
lblLettreHaut(Index).Caption = ancienneValeur
End If

If bas = 1 Then
    If lblLettreHaut(Index).Caption = "" Then
    
    lblLettreHaut(Index).Caption = ancienneValeur
    lblLettreBas(ancienEmplacementBas).Caption = ""
    Else
    
    lblLettreBas(ancienEmplacementBas).Caption = ancienneValeur
    
    End If

End If

bas = 0
haut = 0

End Sub

' Décollage haut
Private Sub lblLettreHaut_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If compteurLettre = 9 Then
    
    lblLettreHaut(Index).Drag
    ancienEmplacementHaut = Index
    ancienneValeur = lblLettreHaut(Index).Caption
    haut = 1
    
End If

End Sub

'creation du reseau utilisant le port 2890
Private Sub CreerPartie_Click()
Call Form_Load
Reseau.Close
Reseau.LocalPort = 2890
Reseau.Listen
info.Caption = "Attente de connection: IP locale= " & Reseau.LocalIP
btLancer.Visible = True

End Sub

Private Sub QuitterLeJeu_Click()
End
End Sub

'connection du second joueur

Private Sub RejoindrePartie_Click()
Call Form_Load
Dim Cur_Time As String
Dim Temp As String
Reseau.Close
Ip = InputBox("Veuillez entrer l'adresse IP ou le nom de la machine server:", "Adresse IP", "172.16.30.5")
Reseau.RemoteHost = Ip
Reseau.RemotePort = 2890
Reseau.Connect
Cur_Time = Time
Temp = 5
Do While Reseau.State <> 7
    If Cur_Time <> Time Then
        Temp = Temp - 1
        Cur_Time = Time
    End If
    If Temp = 0 Then
        MsgBox "Connection impossible !", vbExclamation, "Erreur"
        Reseau.Close
        Exit Sub
    End If
    DoEvents
Loop
Joueur = 2
info.Caption = "Soyez prêt, le joueur 1 va lancer la partie"
btLancer.Visible = False
End Sub
Private Sub btLancer_Click()

'le jeu en reseau commence

If Reseau.State <> 7 Then
    Reseau.Close
    Joueur = 0
    btLancer.Enabled = False
    info.Caption = "Connection interrompue !!!"
    Exit Sub
End If

btLancer.Enabled = False
btLancer.Visible = False

btConsonne.Enabled = True
btConsonne.Visible = True

btVoyelle.Enabled = True
btVoyelle.Visible = True
info.Caption = "c'est parti"

Reseau.SendData "debut"
End Sub
Private Sub Reseau_Close()
Reseau.Close
End Sub

Private Sub Reseau_ConnectionRequest(ByVal requestID As Long)
'une fois les deux joueurs connectes on peut commencer la parti

Reseau.Close
Reseau.Accept requestID
Joueur = 1
info.Caption = "La partie commence !"
btLancer.Enabled = True
End Sub

Private Sub Reseau_DataArrival(ByVal bytesTotal As Long)
Dim packet As String
Reseau.GetData packet

Dim reponse As Integer

'reception du mot de l'autre joueur et validation
If Mid(packet, 1, 3) = "mot" Then

    compteurAutreJoueur = Mid(packet, 5, 1)

    If compteurAutreJoueur = 0 Then
    'reponse nul
    reponse = MsgBox("Pas de mot trouver", vbExclamation + vbOKOnly, "Youpi")
    
        If reponse = 1 Then
        Reseau.SendData ("reponse correcte")
        
        End If
        
        
    Else
    
    reponse = MsgBox("Le mot :" & Mid(packet, 7) & " est il correct?", vbQuestion + vbYesNo, "Mot en " & compteurAutreJoueur & " lettres")
        
        If reponse = 6 Then
        'reponse oui
        Reseau.SendData ("reponse correcte")
        
        
        Else
        'reponse non
        Reseau.SendData ("reponse faux")
        compteurAutreJoueur = -1
        
        
        End If
        
    End If
    
    'mot deux valider
    valider2 = 1
    
        
End If

'reception de la validation
If Mid(packet, 1, 7) = "reponse" Then

    If Mid(packet, 9, 4) = "faux" Then
    'gestion faux
    compteurJoueur = -1
        
    End If
    
    
    valider = 1
    
End If
    

'test du gagnant
If valider = 1 And valider2 = 1 Then

valider = 0
valider2 = 0
    
    'gestion du classement

    If compteurAutreJoueur > compteurJoueur Then
    reponse = MsgBox("Tu as perdu", vbExclamation + vbOKOnly, "Dommage")
    End If

    If compteurAutreJoueur < compteurJoueur Then
    reponse = MsgBox("Tu as gagne", vbExclamation + vbOKOnly, "Bravo")
    End If
    
    If compteurAutreJoueur = compteurJoueur Then
    reponse = MsgBox("Egalite", vbExclamation + vbOKOnly, "Bravo")
    End If
    
    DoEvents
    
      
        If reponse = 1 Then
        reponse = MsgBox("Voulez-vous rejouer?", vbInformation + vbRetryCancel, "Nouvelle Partie")
    
    
            If reponse = 4 Then
                    
            
            Call Form_Load
            Call fChoix
            
                If Joueur = 1 Then
                btConsonne.Enabled = True
                btConsonne.Visible = True

                btVoyelle.Enabled = True
                btVoyelle.Visible = True
                info.Caption = "c'est parti"
                Else
                btConsonne.Enabled = False
                btConsonne.Visible = True

                btVoyelle.Enabled = False
                btVoyelle.Visible = True
                info.Caption = "c'est parti"
                End If
            
            
        
            Else
            
            Reseau.Close
            End
        
            End If
        
        End If
    
    
   
   

End If

If packet = "fin" Then
Reseau.Close
End
End If

If packet = "rejouer" Then

info.Caption = "on recommence"
    
End If
            

If packet = "debut" Then
btConsonne.Enabled = False
btConsonne.Visible = True

btVoyelle.Enabled = False
btVoyelle.Visible = True
info.Caption = "c'est parti"

End If

If Mid(packet, 1, 5) = "envoi" Then

compteurLettre = CInt(Mid(packet, 9, 1))
lblLettreHaut(compteurLettre - 1).Caption = Mid(packet, 7, 1)

    If compteurLettre = 9 Then
    Call fDebut
    Else
    Call fChoix
    End If

End If

End Sub

Conclusion :


merci de me donner des conseils pour améliorer ce code
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 (fabienenvac)