begin process at 2012 05 27 06:56:52
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Jeux

 > JEU DE REFLEXION ET D'ENTRAINEMENT OCULAIRE

JEU DE REFLEXION ET D'ENTRAINEMENT OCULAIRE


 Information sur la source

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Jeux Classé sous :JEU, RELEXION, ENTRAINEMENT, OCULAIRE, TBBUIM Niveau :Débutant Date de création :28/06/2008 Date de mise à jour :30/06/2008 20:13:10 Vu / téléchargé :6 790 / 436

Auteur : tbbuim1

Ecrire un message privé
Site perso
Commentaire sur cette source (14)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

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


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

30 juin 2008 20:13:11 :
Reformulation de la règle du jeu.

 Sources du même auteur

Source avec Zip Source avec une capture JEU EN GIFS ANIMÉS FIRECOIN
Source avec Zip Source avec une capture JEU DE MATH - CALCUL MENTAL
REMPLACER LE SYMBOLE DÉCIMAL
Source avec Zip Source avec une capture OCX PROGRESSBAR SANS FIN PARAMÉTRABLE
Source avec Zip Source avec une capture DEMINEUR RESEAU TYPE MSN WINSOCK

 Sources de la même categorie

Source avec Zip [VBA] TOWER BATTLE 4 par Softmama
Source avec Zip Source avec une capture [VBA] TOWER BATTLE 3 par Softmama
Source avec Zip Source avec une capture Source .NET (Dotnet) XBOXLIVE AVATAR DOWNLOAD par quentinix
Source avec Zip Source avec une capture Source .NET (Dotnet) GÉNÉRATEUR DE GRILLES DE MOTS MÉLÉS par ardeliner
Source avec Zip HUTOWERS JEU DE CARTES SIMILAIRE AU VIEIL ADATOWERS QUI NE M... par roudoudou2708

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture COLUMETRIS par Softmama
Source avec Zip Source avec une capture Source .NET (Dotnet) DES CHIFFRES ET DES LETTRES par ShayW
Source avec Zip Source avec une capture JEU EN GIFS ANIMÉS FIRECOIN par tbbuim1
Source avec Zip Source avec une capture BMW SERIE 7 par serge_saati
Source avec Zip Source avec une capture $$$ BLACKJACK $$$ LE CÉLÈBRE JEU DU 21 PRATIQUÉ DANS LES CAS... par FrAnCkY555

Commentaires et avis

Commentaire de us_30 le 30/06/2008 09:00:56 10/10

1100 points ! amusant... 10/10.

Il faut surtout rechercher les plus grands rectangles possibles...

A+
Amicalement,
Us.

Commentaire de Sechaud le 30/06/2008 10:50:14

J'ai essayé ton jeu.L'idée est excellente mais chez moi, ce ne sont pas des rectangles qui fonctionnent mais des carrés de 4 cases de couleur identique. Si on clique sur un VRAI rectangle de 4 cases celà ne marche pas.

Commentaire de tbbuim1 le 30/06/2008 11:17:16

Pour Us_30 apparemment ça marche correctement et pour moi également, j'ai testé le jeu en long, en large et en travers avant de le mettre en ligne... J'ai remarqué cependant que si on cliquait trop vite, il arrivait parfois qu'il ne prenne pas en compte l'un des clics. A part ça, je détermine bien les coins d'un rectangle dans la fonction rectangle, il n'y a pas de doute possible. Peut être es-tu daltonien et tu as l'impression de cliquer sur les bonnes cases, (je ne plaisante pas ma copine a eu le mm problème étant daltonienne, j'ai dû mettre les cases oranges en jaune pour qu'elle puisse faire la différence...)
a b  => (x1,y1) (x2,y1)
c d  => (x1,y4) (x4,y4)
on a bien x4 et y4 <> et x1 et y1
b qui est à la mm hauteur de a
c qui est à la mm hauteur de d

Donc, apparemment, pas de doute possible. Tiens moi au courant si tu t'aperçois que tu t'es trompé, essayes de cliquer moins vite, testes avec un plus petit rectangle, demandes à quelqu'un d'autre de tester, etc
Par avance merci.
Si quelqu'un à le même soucis ou si tout va bien :), merci de me l'indiquer (pour ma part, je n'ai aucun problème de ce genre)

Commentaire de Sechaud le 30/06/2008 11:46:28

Je fais très bien la différence entre le rouge et le orange.J'ai quand même essayé en mettant du jaune avec vbYellow à la place du orange mais seul des CARRÉS fonctionnent.Un vrai RECTANGLE de 4 cases garde son aspect, même si on clique doucement.

Commentaire de tbbuim1 le 30/06/2008 11:58:58

J'ai encore testé pas plus tard que ce matin 11:15 avec le fichier zip fournit par VBFrance et je n'ai pas ce problème. Désolé :(

Commentaire de PCPT le 30/06/2008 13:46:30 administrateur CS

192 pts ^^
çà semble vraiment lié à la grille de départ, chance ou pas.
à moins que.... :
je confirme l'info (le bug ??) de Sechaud :
n'est pris en compte qu'un carré, pas un rectangle.

donc
XX
XX

pas
XXXX


us_30 parle des "plus grands rectangles", j'en déduis qu'en effet il y a un souci ^^
VB6 SP6 Win2000 SP4+1

je click sur une "colonne de carré" du bas vers le haut, à peu près au milieu du plateau
arrivé au 4e click, code ligne 157, a=3 et b=0 (pour 2 et 2 attendus)

Commentaire de tbbuim1 le 30/06/2008 14:09:36

je sais pas comment vous faites...
J'arrive à trouver des rectangles et des carrés de toutes les tailles. Je clic de bas en haut, en diagonale et à n'importe quel endroit du plateau, les rectangles sont tjs pris en compte, comptabilisés dans les points et modifiés. à aucun moment je ne clic sur un rectangle qui n'est pas comptabilisé.
PCPT, tu me dis que ce serait une erreur dû au SP6?
Je ne comprends pas non plus ton XXXX????
ni ce que tu entends par une "colonne carré".
Si tu entends par là que toutes les cases se trouvent sur la même ligne ou colonne, alors ce n'est pas un rectangle, c'est une droite... si on considère les cases comme des points. donc c'est normal que ce ne soit pas comptabilisé. Pourrais-tu me donner un exemple précis, stp? Par exemple avec coordonnées des points que tu as cliqué et qui n'a donné aucun résultat alors que cela aurait dû. Parce que je n'arrive vraiment pas à reproduire. Merci
Pour ce qui est des points et de la chance, oui ya un peu de chance dans le tri de départ, mais il a tjs quelques rectangles à faire, c'est là que l'entrainement devient utile. A force de jouer, on remarque de plus en plus facilement les rectangles. Il faut faire de petits rectangles ou carrés pour changer les couleurs et pouvoir faire apparaître des plus grands...

Commentaire de PCPT le 30/06/2008 14:56:14 administrateur CS

non je ne dis pas que çà vient du SP6, je te précisais ma config, à toi de voir ^^

"colonne de carrés" j'entendais en effet ce que tu entends apparemment par "droite".
pour çà que j'ai dis que je confirmais "l'info" et non "le bug"

tu dis bien "les rectangles sont tjs pris en compte"
ce qui laisse entendre qu'une "surface" de 3 lignes sur 2 colonnes (un rectangle ^^) doit pouvoir être sélectionnée.
beh pas chez moi....

tu as 9 colonnes (disons de A à I), sur 12 lignes (de 1 à 12)
supposons en bleu le rectangle suivant :

A1 B1 C1
A2 B2 C2

je ne peux avoir dedans QUE le carré :
A1 B1
A2 B2
OU
B1 C1
B2 C2

(cette explication devrait aussi te montrer ce que je disais avec 'X X X X')

de par ce fonctionnement (seulement un carré de 4 cases), il devient alors inutile de trouver des carrés "plus grands"

Commentaire de tbbuim1 le 30/06/2008 15:08:19

Ok. Comme je disais chez moi et au boulot, le rectangle
A1 C1
A2 C2 est possible...
J'ai la version anglaise de VB
Et le VB6 SP6. j'ai testé sous Vista et sous XP, ça tourne comme il faut. j'ai pas testé sous win2000...
Ca vient peut être de là ^^
Peut être avez-vous la version française de VB; qui sait.
La vérité est ailleurs... :p

Commentaire de PCPT le 30/06/2008 15:19:51 administrateur CS

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

Commentaire de PCPT le 30/06/2008 15:30:20 administrateur CS

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

Commentaire de tbbuim1 le 30/06/2008 17:54:09

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.

Commentaire de PCPT le 30/06/2008 18:16:08 administrateur CS

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

Commentaire de tbbuim1 le 30/06/2008 20:00:26

lol, désolé pour le manque de tact ^^
Et merci pour tes conseils avisés...

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Jeu de dames [ par Christophe ] Je cherche à réaliser un mini-jeu de dames. Sachant qu'on doit pouvoir ensuite gérer des événements Drag-Drop, quels types de contrôles dois-je utilis winamp et VB5 [ par Rescator ] bonjourj'utilise un petit prog ecris sous vb5 pour commander un jeu de lumière par le port // de mon PC. seulement j'aimerais récupérer le tempo de la bouger objet avet une manette de jeu? [ par ZIDANE ] Est ce que quelqu'un sait comment faire pour bouger un objet avec une mannette de jeu ordinaire ? (gamepad)Si vous avez la réponse pouvez vous me l'en Jeu de tir à la Rogue Spear [ par Nat ] Salut.Je développe un jeu de tir et j'ai grave besoin d'aide.Il me manque un graphiste et j'aimerais aussi savoir comment on fait pour interpréter la SOURCE JEU D'ECHEC [ par TOUATI ] POUR UN HANDICAPE SEMI VISUEL JE CHERCHE DES SOURCES POUR ADAPTER CE JEU A CES PROBLEMES POUR CELA JE CHERCHE /1/ les sources d'un jeu d'echec 2 / un Cmt afficher une fenetre par dessus un jeu windows ? [ par lechti62 ] Bonjour je voudrai savoir si il est possible quand un jeu Windows ou Direct Xest lancé, de pouvoir afficher un programme fait avec VB par dessus ce je Comment creer un serveur de jeux en reseaux? [ par Momo3dfx ] Salut a tous,j'ai un exellent site, sur un jeu, j'ai du matos pour faire un serveur, j'ai tout sauf l'expérience et el savoir faire.-Comment fait-on p AIDE DATA SVP ! [ par Seb ] Je fais un programme jeu :j ai une basse access que j accede grace au data de vb et j aimerai mettre a jour le score d'une personne à la fin d un jeu. Tri d'un fichier pour un jeu [ par @ thedentiste @ ] J'aimerai savoir comment peut on trier un fichierc'est pour faire une table des scores avec deux éléments le nom du joueur et le score Merci d'avance@ DX : aidez moi svp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! [ par Ophidian ] a ceux qui sy connaissent et aux autres :dans la source du moteur3D en DX de je sais plus qui, on est dans un monde en 3D et on peut bouger. Comment f


Nos sponsors


Sondage...

CalendriCode

Mai 2012
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

Consulter la suite du CalendriCode

A découvrir



 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 1,700 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales