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