Les tours de hanoi (jeu)

Télécharger le projet
Commenter

Description

ceci est un jeu Graphique sur le principe des Tours de Hanoi
rappel des règles :
il s'agit de déplacer les assiettes de la pile de gauche sur la pile de droite
avec les contraintes suivantes
- ne prendre qu'une assiette à la fois
- ne pas poser une assiette plus grosse sur une assiette plus petite
chercher la solution donnant le moins de déplacements possibles

pour les programmeurs, ceci est un exercice sur la création et manipulation des collections d'objets.
Ceci permet une optimisation mémoire par la création dynamique du nombre d'objets strictement nécessaires.

créer les controles suivants sur la forme :
boutons : cmdDépart, cmdQuitter, cmdReplay
images : Img(0), Img(1) Img(2)
labels : LBF(0), LBF(1) LBF(2), lblNbCoups...
radioboutons : opt(0) ... opt(8)
combobox : cboCoups
timers : Timer et TimerReplay
...

Source / Exemple : 


'*********************************************************************
'ce programme est un exercice sur la création dynamique de controles
'*********************************************************************
Option Explicit
Enum plot
    Aucun = 0
    Gauche = 1
    Milieu = 2
    Droite = 3
End Enum
Private ck1 As plot, ck2 As plot
Private nbAssiettes As Integer
Private nbTotal As Integer
Private Assiettes(1 To 3) As New Collection
Private TopDépart As Date
Private CoupsJoués As New Collection
Private CoupsReplay As New Collection
Private Const margeBasse = 50
Private iReplay As Integer

'*******************************************
'procédure d'initialisation des trois piles
'*******************************************
Private Sub cmdDépart_Click()
Dim i  As Integer
For i = 0 To 8
    If opt(i) Then opt_Click (i)
Next
TopDépart = Time
Timer.Enabled = True
End Sub

'*******************************************
'sans commentaire ...
'*******************************************
Private Sub cmdQuitter_Click()
Unload Me
End Sub

'*********************************************************************
'une option sympatique pour rejouer son parcourt à plusieurs vitesses
'*********************************************************************
Private Sub cmdreplay_Click()
Dim i As Integer
For i = CoupsReplay.Count To 1 Step -1
Déplacer CoupsReplay.Item(i), True
Next
iReplay = 0
TimerReplay.Enabled = True
End Sub

'**************************************************
' permet de jouer au clavier plutot qu'à la souris
' utiliser dans ce cas les touches F1, F2 et F3
'**************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF1: Img_Click (0)
Case vbKeyF2: Img_Click (1)
Case vbKeyF3: Img_Click (2)
Case vbKeyBack, vbKeyEscape: Annuler
End Select
End Sub

'*******************************************
'procédure d'initialisation générale
'*******************************************
Private Sub Form_Load()
Dim i As Integer
ck1 = Aucun: ck2 = Aucun
nbAssiettes = 1
nbTotal = 4
lblIdéal = 2 ^ nbTotal - 1
Assiettes(1).Add Shape(0)
CréePiles
TopDépart = 0
Timer.Enabled = False
TimerReplay.Interval = 1000 - 180 * Slider.Value
End Sub

'***********************************************************
'procédure de déplacement des assiettes sur les trois piles
' suite au clic sur les images
'***********************************************************
Private Sub Img_Click(Index As Integer)
If ck1 = Aucun Then
If Assiettes(Index + 1).Count = 0 Then Exit Sub
ck1 = Index + 1
lbl = ck1 & " -> ?"
Else
ck2 = Index + 1
If Not VérifDéplacement(ck1, ck2) Then lbl = "? -> ?": Exit Sub
lbl = ck1 & "-> " & ck2
CoupsJoués.Add 10 * ck1 + ck2
cboCoups.AddItem ck1 & "->" & ck2
lblNbCoups = lblNbCoups + 1
Déplacer CStr(ck1) & CStr(ck2)
ck1 = Aucun: ck2 = Aucun
End If
If nbAssiettes = Assiettes(3).Count Then
    Timer.Enabled = False
    MsgBox "gagné !", vbInformation + vbMsgBoxSetForeground, "Tours de Hanoï"
    Set CoupsReplay = CoupsJoués
    Set CoupsJoués = Nothing
    Set CoupsJoués = New Collection
    cmdreplay.Enabled = True
End If
End Sub

'*******************************************
'idem Img_Click ...
' suite au clic sur les zones F1, F2 ou F3
'*******************************************
Private Sub lblF_Click(Index As Integer)
Img_Click (Index)
End Sub

'*******************************************
'sans commentaire ...
'*******************************************
Private Sub CréePiles()
Dim i As Integer, nbT As Integer
Shape(0).Left = Img(0).Left + (Img(0).Width - Shape(0).Width) / 2
Shape(0).Top = Img(0).Top + (Img(0).Height - Shape(0).Height) - margeBasse

'd'abord retirer toutes les assiettes du jeu précédent
For i = nbAssiettes - 1 To 1 Step -1
    Unload Shape(i)
Next

'détruire puis reconstruire la collection des piles
For i = 1 To 3
Set Assiettes(i) = Nothing
Set Assiettes(i) = New Collection
Next

'ajouter l'assiette 0 (le modèle) à la pile 1
Assiettes(1).Add Shape(0)
nbAssiettes = 1

'créer le nombre d'assiettes nécessaires, les dimensionner et les ajouter
' à leur emplacement sur la pile 1
If nbAssiettes < nbTotal Then
    For i = nbAssiettes To nbTotal - 1
    Load Shape(i)
    Shape(i).ZOrder
    Shape(i).Width = Shape(0).Width * (10 - i) / 10
    Shape(i).Top = Shape(i - 1).Top - Shape(0).Height
    Shape(i).Left = Shape(i - 1).Left + (Shape(i - 1).Width - Shape(i).Width) / 2
    Shape(i).Visible = True
    Assiettes(1).Add Shape(i)
    Next
End If
nbAssiettes = nbTotal
End Sub

'*******************************************
' procédure gérant les choix du niveau
' le nombre d'assiettes
'*******************************************
Private Sub opt_Click(Index As Integer)
cmdreplay.Enabled = False
nbTotal = Index + 1
lblIdéal = 2 ^ (nbTotal) - 1
lblNbCoups = 0
CréePiles
Timer.Enabled = False
lblChrono = "00:00"
Set CoupsReplay = Nothing
Set CoupsReplay = New Collection
Set CoupsJoués = Nothing
Set CoupsJoués = New Collection
cboCoups.Clear
End Sub

'*******************************************
' procédure vérifiant les règles du jeu ...
' - pas de déplacement à partir d'une pile vide
' - pas de déplacement d'une pile vers elle meme
' - pas de grosse assiette sur une petite
'*******************************************
Private Function VérifDéplacement(ByRef ck1 As plot, ByRef ck2 As plot)
Dim sh1 As Shape, sh2 As Shape
If ck1 = ck2 Then GoTo Rate
If Assiettes(ck1).Count = 0 Then GoTo Rate
If Assiettes(ck2).Count > 0 Then
    Set sh1 = Assiettes(ck1).Item(Assiettes(ck1).Count)
    Set sh2 = Assiettes(ck2).Item(Assiettes(ck2).Count)
    If (sh1.Index < sh2.Index) Then
    MsgBox "gros sur petit !" & vbCrLf & "Interdit": GoTo Rate
    End If
End If
VérifDéplacement = True
Exit Function
Rate:
Beep: ck1 = Aucun: ck2 = Aucun
VérifDéplacement = False
End Function

'*******************************************************
' permet d'annuler une (ou plusieurs) actions
' en appuyant sur la touche BACKSPACE ...
' remarque : ceci décrémente aussi le compteur de coups
'*******************************************************
Private Sub Annuler()
Dim codeDer As Integer, c1 As plot, c2 As plot
If (CoupsJoués.Count = 0 Or (ck1 <> Aucun And ck2 = Aucun)) Then
MsgBox "Impossible d'annuler"
Exit Sub
End If
codeDer = CInt(CoupsJoués.Item(CoupsJoués.Count))
c1 = codeDer \ 10
c2 = codeDer - 10 * c1
Img_Click (c2 - 1)
Img_Click (c1 - 1)
cboCoups.RemoveItem cboCoups.ListCount - 1
cboCoups.RemoveItem cboCoups.ListCount - 1
CoupsJoués.Remove CoupsJoués.Count
CoupsJoués.Remove CoupsJoués.Count
lblNbCoups = lblNbCoups - 2
End Sub

'***************************************************
' procédure de rappel (CallBack) du Timer principal
'***************************************************
Private Sub Timer_Timer()
lblChrono = Format(Time - TopDépart, "Nn:Ss")
End Sub

'************************************************************
' procédure de rappel (CallBack) du Timer Secondaire (replay)
'************************************************************
Private Sub TimerReplay_Timer()
cmdDépart.Enabled = False
cmdQuitter.Enabled = False
cmdreplay.Enabled = False
iReplay = iReplay + 1
Déplacer CoupsReplay.Item(iReplay)
If iReplay = CoupsReplay.Count Then TimerReplay.Enabled = False
cmdDépart.Enabled = True
cmdQuitter.Enabled = True
cmdreplay.Enabled = True
End Sub

'*******************************************
'permet de régler la vitesse du replay ...
'*******************************************
Private Sub Slider_Change()
TimerReplay.Interval = 1000 - 180 * Slider.Value
End Sub

'************************************************************************
'procédure effectuant réellement le déplacement graphique des assiettes
'************************************************************************
Private Sub Déplacer(s As String, Optional bArrière As Boolean = False)
Dim x As plot, y As plot
If bArrière Then
y = Left(s, 1): x = Right(s, 1)
Else
x = Left(s, 1): y = Right(s, 1)
End If
If Assiettes(y).Count = 0 Then
    Assiettes(x)(Assiettes(x).Count).Top = Img(y - 1).Top + Img(x - 1).Height - Shape(0).Height - margeBasse
Else
    Assiettes(x)(Assiettes(x).Count).Top = Assiettes(y)(Assiettes(y).Count).Top - Shape(0).Height
End If
Assiettes(x)(Assiettes(x).Count).Left = Img(y - 1).Left + (Img(0).Width - Assiettes(x)(Assiettes(x).Count).Width) / 2
Assiettes(y).Add Assiettes(x)(Assiettes(x).Count)
Assiettes(x).Remove Assiettes(x).Count
End Sub

'*******************************************
'sans commentaire ...
'*******************************************
Private Sub lblAuteur_Click()
If lblAuteur = "Auteur" Then
    lblAuteur = "Jean-Louis-VIDAL@wanadoo.fr"
Else
    lblAuteur = "Auteur"
End If
End Sub

Conclusion :


utilise la DLL runtime de VB6
MSVBVM60.DLL
et les controles activex de : Microsoft Windows Common Control 6.0
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 (cs_vieuxLion)