Jeu de reflexion et d'entrainement oculaire
Soyez le premier à donner votre avis sur cette source.
Vue 8 863 fois - Téléchargée 589 fois
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.
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
Codes Sources
A voir également
- Jeu de reflexion et d'entrainement oculaire
- Reflexion java - Conseils pratiques -Java
- Generateur de nom de jeu ✓ - Forum Flash
- Buzzers jeu - Forum C
- Demineur jeu - Forum Java
- Jeu solitaire carte - Forum C / C++ / C++.NET
30 juin 2008 à 20:00
Et merci pour tes conseils avisés...
30 juin 2008 à 18:16
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
30 juin 2008 à 17:54
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.
30 juin 2008 à 15:30
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
30 juin 2008 à 15:19
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 ^^
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.