Jeu de reflexion et d'entrainement oculaire

Soyez le premier à donner votre avis sur cette source.

Vue 8 359 fois - Téléchargée 535 fois

Télécharger le projet
Commenter

Description

Le jeu consiste à repérer 4 cases de la même couleur, formant un rectangle parmi toutes les cases de couleurs mélangées. Attention, vous ne pouvez pas faire de rectangle ayant les 4 cases sur la même ligne ou colonne. Pour se faire, vous devez cliquer sur chacunes d'entres elles. Vous gagnerez alors des points en fonction de la taille du rectangle trouvé. Les cases composant ce rectangle changeront alors de couleur.
Vous avez 1 minute pour trouver un maximum de rectangles.
Amusez-vous bien.

Source / Exemple : 


Option Explicit
Dim Ind(3, 1) As Variant 'de 0 à 3 index clignotant et 2eme dim pr stocker la couleur
Dim Damier(107, 1) As Integer 'On stock la position des cases pour faciliter le calcul
Dim First As Boolean 'Indique qu'on vient de lancer le jeu
Dim Fin As Boolean 'Indique que le jeu est terminé
'Ouverture de l'application
Private Sub Form_Load()
    Randomize 'Activation de la fonction permettant d'avoir des chiffres aléatoire
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim ran As Integer
    k = 0 'Index du carré dont sont issus tous les autres
    First = True: Fin = False
    Left = (Screen.Width - Width) / 2 ' on centre la fenetre sur la gauche
    Top = (Screen.Height - Height) / 2 'et en hauteur
    For j = 0 To 11 'k = 0  1  2  3  4  5  6  7  8
        For i = 0 To 8 ' 9 10 11 12 13 14 15 16 17
            Damier(k, 0) = i 'On stock la position des cases pour faciliter le calcul
            Damier(k, 1) = j
            If ((i <> 0) Or (j <> 0)) Then  'On passe la 1ere case qui existe par défaut
                Load Img(k) 'création de chaque bouton de la grille
                Img(k).Visible = True 'on les rend visibles et on les place
                Img(k).Left = 400 * (i) 'abscisse
                Img(k).Top = 400 * (j) 'ordonnée
                ran = CInt(Rnd * 3) + 1 'choix d'un chiffre entre 0 et 3 (+1)
                Select Case ran
                    Case 1: Img(k).BackColor = vbRed
                    Case 2: Img(k).BackColor = vbBlue
                    Case 3: Img(k).BackColor = vbGreen
                    Case 4: Img(k).BackColor = RGB(255, 127, 0) 'Orange
                End Select
                k = k + 1 'case suivante
            Else
                k = k + 1 'case suivante
            End If
        Next i
    Next j
    InitClick
End Sub
'Gestion du click sur une case
Private Sub Img_Click(Index As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim c As Integer 'Indique qu'on a bien un rectangle
    If Fin = False Then 'Si ce n'est pas la fin du jeu on permet le click
        First = False: c = 0
        For i = 0 To 3
            If Active(Index) = False Then 'Si on a pas encore cliqué sur cette case
                If Ind(i, 0) = 200 Then
                    Ind(i, 0) = Index 'On récupère l'index qui a été cliqué pour le faire clignoter
                    Ind(i, 1) = Img(Index).BackColor 'On récupère a couleur de la case
                    If i = 3 Then 'Si c'est le 4eme carré qu'on choisi alors on vérifie si la couleur identique
                        For j = 1 To 3
                            If (Ind(j, 1) = Ind(0, 1)) Then c = c + 1 'couleur identique
                        Next j
                        If c = 3 Then 'Si on les mm couleurs alors on rectangle si c'est un rectangle
                            Rectangle 'fonction vérifiant si c'est un rectangle
                        Else
                            InitClick 'alors on réinitialise le choix des cases
                        End If
                        
                    Else 'Sinon on quitte la boucle
                        Exit For 'On quitte la boucle
                    End If
                End If
            Else 'Si on a déjà cliqué sur cette case, on la réinitialise
                If (Ind(i, 0) = Index) Then
                    Img(Ind(i, 0)).BackColor = Ind(i, 1) 'On redonne la couleur d'origine
                    Ind(i, 0) = 200 'Initialisation des index nb 200 arbitraire
                    Ind(i, 1) = vbBlack 'On réinitialise en noire la couleur de la case nulle
                    InitClick 'On réinitialise tout
                    Exit For
                End If
            End If
        Next i
    End If
End Sub
'On relance une nouvelle partie
Private Sub New_Click()
    Randomize
    Dim k, i, j, ran As Integer
    Fin = False
    k = 0 'Index du carré dont sont issus tous les autre
    For j = 0 To 11 'k = 0  1  2  3  4  5  6  7  8
        For i = 0 To 8 ' 9 10 11 12 13 14 15 16 17
            ran = CInt(Rnd * 3) + 1 'choix d'un chiffre entre 0 et 3 (+1)
            Select Case ran
                Case 1: Img(k).BackColor = vbRed
                Case 2: Img(k).BackColor = vbBlue
                Case 3: Img(k).BackColor = vbGreen
                Case 4: Img(k).BackColor = RGB(255, 127, 0) 'Orange
            End Select
            k = k + 1 'case suivante
        Next i
    Next j
    InitClick
    Me.Score = "0"
    Me.Bar.Width = 1300
End Sub
'Permet de faire clignoter les cases toutes les 1/2 secondes - 500ms
Private Sub Timer_Timer()
    Dim i As Integer
    For i = 0 To 3
        If Ind(i, 0) <> 200 Then
            If Img(Ind(i, 0)).BackColor <> vbWhite Then
                Img(Ind(i, 0)).BackColor = vbWhite 'Blanc
            Else
                Img(Ind(i, 0)).BackColor = Ind(i, 1) 'Couleur originale
            End If
        End If
    Next i
    'Animation de la progress bar du temps
    'Environ 60s width = 1300
    'Pour augmenter le temps de réponse, changez l'interval ou réduisez moins vite la progress bar
    If ((Me.Bar.Width - 10) <= 0) Then
        Me.Bar.Width = 0
        Fin = True
        MsgBox "Le temps imparti est terminé"
        InitClick
    Else
        Me.Bar.Width = Me.Bar.Width - 10
    End If
End Sub
'On vérifie si on a bien un rectangle
Private Sub Rectangle()
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim i As Integer
    a = 0: b = 0
    'On check si un coin existe
    For i = 1 To 3 'Si' l'un des x est égal au premier
        If (Damier(Ind(i, 0), 1) = Damier(Ind(0, 0), 1)) Then a = a + 1 'abcisse
        If (Damier(Ind(i, 0), 0) = Damier(Ind(0, 0), 0)) Then a = a + 1 'ordonnée
    Next i
    If a = 2 Then 'Si on a trouvé un coin de rectangle alors
        'On check si un 2eme coin exite
        For i = 1 To 3 'on check si une des cases est opposée au coin a
            If ((Damier(Ind(i, 0), 0) <> Damier(Ind(0, 0), 0)) And (Damier(Ind(i, 0), 1) <> Damier(Ind(0, 0), 1))) Then
                c = Ind(i, 0) 'On garde l'index qui est opposé pour la vérification
            End If
        Next i
        For i = 1 To 3 'on check si une des cases est opposée au coin a
            If ((Damier(Ind(i, 0), 0) <> Damier(Ind(0, 0), 0)) And (Damier(Ind(i, 0), 1) <> Damier(Ind(0, 0), 1))) Then
                c = i 'On garde l'index qui est opposé pour la vérification
            End If
        Next i
        For i = 1 To 3 'on check si une des cases est opposée au coin a
            If (c <> i) Then 'Si on est pas sur le coin opposé à ind(0,0)
                If (Damier(Ind(i, 0), 1) = Damier(Ind(c, 0), 1)) Then b = b + 1 'abcisse
                If (Damier(Ind(i, 0), 0) = Damier(Ind(c, 0), 0)) Then b = b + 1 'ordonnée
            End If
        Next i
    End If
    If ((a = 2) And (b = 2)) Then 'Alors on a un rectangle ou un carré
        Regeneration
    Else
        'Alors on a cliqué sur 4 carrés de la mm couleur mais ne formant pas un rectangle
        InitClick 'On réinitialise les clicks
    End If
End Sub
'Vérifie si on a déjà cliqué sur cette case
Private Function Active(Index) As Boolean
    Dim i As Integer
    Active = False
    For i = 0 To 3 'Si on a une égalité alors on a déjà cliqué dessus
        If (Ind(i, 0) = Index) Then Active = True: Exit For
    Next i
End Function
'On met de nouvelle couleur dans la zone validée
Private Sub Regeneration()                                        'a b
    Randomize                                                     'c d
    Dim ran As Integer
    Dim Coins(3, 1) As Integer 'on détermine les 4 coins du carré
    Dim i, j, x1, x2, x3, x4, y1, y2, y3, y4, a, b, k As Integer
    x1 = 10: y1 = 20 'a
    x4 = 0: y4 = 0 'a
    'Recherche du point a(x1,y1)
    For i = 0 To 3
        If ((Damier(Ind(i, 0), 0) <= x1) And (Damier(Ind(i, 0), 1) <= y1)) Then
            x1 = Damier(Ind(i, 0), 0)
            y1 = Damier(Ind(i, 0), 1)
            a = Ind(i, 0) 'on récupère le coin a
        End If
    Next i
    'Recherche du point b(x2,y2)
    For i = 0 To 3 'Si c'est sur la mm hauteur que a mais que ce n'est pas lui mm
        If ((Damier(Ind(i, 0), 1) = y1) And (Damier(Ind(i, 0), 0) <> x1)) Then
            x2 = Damier(Ind(i, 0), 0) 'on stock la position de b pour calculer la surface et sa position
            y2 = Damier(Ind(i, 0), 1) 'et hauteur de b
        End If
    Next i
    'Recherche du point d(x4,y4)
    For i = 0 To 3 'le coin opposé n'a rien en commun avec x1 et y1
        If ((Damier(Ind(i, 0), 0) <> x1) And (Damier(Ind(i, 0), 1) <> y1)) Then
            x4 = Damier(Ind(i, 0), 0)
            y4 = Damier(Ind(i, 0), 1)
        End If
    Next i
    'Recherche du point c(x3,y3)
    For i = 0 To 3 'S'il a la mm hauteur que le coin opposé mais que ce n'est pas lui mm évidemment
        If ((Damier(Ind(i, 0), 1) = y4) And (Damier(Ind(i, 0), 0) <> x4)) Then
            x3 = Damier(Ind(i, 0), 0)
            y3 = Damier(Ind(i, 0), 1)
        End If
    Next i
    'Calcul du score nb de cases fois 6        'largeur    *     hauteur     * 6
    Me.Score = CStr(CInt(Me.Score.Text) + (((x4 - x1) + 1) * ((y4 - y1) + 1) * 6))
    InitClick 'On réinitialise les clicks
    k = a 'on fait partir le compteur du coin en haut à gauche
    b = 0 'on compte le nombre de ligne de la zone cliquée
    'On récupère le rectangle trouvé et on change la couleur de ses cases
    For j = y1 To y4
        For i = x1 To x4
            ran = CInt(Rnd * 3) + 1 'choix d'un chiffre entre 0 et 3 (+1)
            While ran = SearchColor(k) 'Tant qu'on a la mm couleur on en cherche une autre
                ran = CInt(Rnd * 3) + 1 'choix d'un chiffre entre 0 et 3 (+1)
            Wend
            Select Case ran
                Case 1: Img(k).BackColor = vbRed
                Case 2: Img(k).BackColor = vbBlue
                Case 3: Img(k).BackColor = vbGreen
                Case 4: Img(k).BackColor = RGB(255, 127, 0) 'Orange
            End Select
            k = k + 1
        Next i
        b = b + 1 'On incrémente la ligne
        'On change de ligne, donc on part de la position du clic en haut à gauche + 9 * nb de ligne
        k = a + (9 * b) 'Voir k dans form_load
    Next j
End Sub
'Initialisation du tableau qui stocke les 4 choix qui compose le rectangle choisit
Private Sub InitClick()
    Dim i As Integer
    For i = 0 To 3 'On redonne la couleur de la case stockée
        If First = False Then
            If Ind(i, 0) <> 200 Then Img(Ind(i, 0)).BackColor = Ind(i, 1)
        End If
        Ind(i, 0) = 200 'Initialisation des index nb 200 arbitraire
        Ind(i, 1) = vbBlack 'On réinitialise en noire la couleur de la case nulle
    Next i
End Sub
'Recherche d'une couleur différente de celle d'origine
Private Function SearchColor(k) As Integer
    Select Case Img(k).BackColor
        Case vbRed: SearchColor = 1
        Case vbBlue: SearchColor = 2
        Case vbGreen: SearchColor = 3
        Case RGB(255, 127, 0): SearchColor = 4
    End Select
End Function
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
tbbuim1
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
 7 -
lol, désolé pour le manque de tact ^^
Et merci pour tes conseils avisés...
Signaler
PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
 28 -
toujours autant de tact et d'amabilité...

4 points c'est 4 points. un carré, un losange, un rectangle, un parallélogramme, ...

un rectangle c'est une MÊME surface dont les 4 coins forment chacun un angle droit, ce qui est le cas avec une droite par la nature de tes points formés par des carrés...

c'est donc bien un problème de compréhension ou d'explication (je te laisse le choix), il n'y a pas de bug

le code n'est pas optimisé (dommage dans ce cas de ne pas avoir de notion objet) mais par chance il est abondamment commenté, et la jouabilité est correcte :)

plus qu'à travailler un peu le graphisme, sauver les scores, quelques sons, historique du "plus gros score en un coup", niveaux des parties (difficile pour un tableau aléatoire mais çà peut jouer sur... le temps de la partie, la nuance des couleurs moins marquée, etc...) et çà peut devenir pas mal
Signaler
tbbuim1
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
 7 -
Pour moi, l'image qui se trouve sur ton lien EST un rectangle, en quoi ça ne le serait pas????
On doit trouver 4 coins d'un rectangle de la mm couleur
Et c'est EXACTEMENT ce que l'on a sur ton lien.
a b => G0 H0
c d => G7 H7
on a bien (a, b) et (c, d) sur le mm axe des abcisses et
on a bien (a, c) et (b, d) sur le mm axe des ordonnées.
Ce qui au final donne forcément un rectangle ou un carré.
Où est le pb? en quoi ce n'est pas un rectangle? On a bien 4 angles droits, non? Peut être que la règle n'est pas très explicite sur ce point... en tout cas, vous me rassurez, votre "bug" n'est en faite, qu'une mauvaise compréhension de la règle. je tacherais de la reformuler.
Merci pour vos commentaires en tout cas.
Signaler
PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
 28 -
ouai enfin çà donne du pas très logique quand même...

si je sélectionne juste 2 "lignes de 2 cases" qui sont sur le même axe, çà n'est pas pour autant un rectangle de la même couleur...

et pourtant
http://www.monsterup.com/upload/1214832546.jpg
Signaler
PCPT
Messages postés
13298
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
 28 -
...c'est plus simple que çà.
même pour un rectangle de A1 à F2 par exemple, Sechaud et moi devions cliquer sur toutes les cases, par exemple A1 B1 C1 D1, au lieu de A1 F1 F2 A2. dans ce 2 cas çà fonctionne ^^
Afficher les 14 commentaires
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 (tbbuim1)