Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Ce site au démarrage

begin process at 2012 05 27 06:56:52

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

Jeux

> JEU DE REFLEXION ET D'ENTRAINEMENT OCULAIRE

JEU DE REFLEXION ET D'ENTRAINEMENT OCULAIRE

Information sur la source

Note :

10,00 / 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 !

Blobs.frm 18 039 octets
Blobs.frx1 090 octets
Blobs.vbp 713 octets
Blobs.vbw 50 octets
Blobs2.JPG 28 036 octets

Télécharger le zip

Historique

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

Sources du même auteur

JEU EN GIFS ANIMÉS FIRECOIN

JEU DE MATH - CALCUL MENTAL

REMPLACER LE SYMBOLE DÉCIMAL

OCX PROGRESSBAR SANS FIN PARAMÉTRABLE

DEMINEUR RESEAU TYPE MSN WINSOCK

Toutes les sources de tbbuim1

Sources de la même categorie

[VBA] TOWER BATTLE 4 par Softmama

[VBA] TOWER BATTLE 3 par Softmama

XBOXLIVE AVATAR DOWNLOAD par quentinix

GÉNÉRATEUR DE GRILLES DE MOTS MÉLÉS par ardeliner

HUTOWERS JEU DE CARTES SIMILAIRE AU VIEIL ADATOWERS QUI NE M... par roudoudou2708

Toutes les sources de la catégorie Jeux

Sources en rapport avec celle ci

COLUMETRIS par Softmama

DES CHIFFRES ET DES LETTRES par ShayW

JEU EN GIFS ANIMÉS FIRECOIN par tbbuim1

BMW SERIE 7 par serge_saati

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

Derniers Blogs

IMAGINE CUP 2012, MAKE A SIGN EN FINALE par junarnoalg

KINECT 1.5 IS OUT ! par Vko

LES ACTUALITéS DE LA SEMAINE SUR C2I.FR (14 MAI - 20 MAI) par richardc

REACTIVE EXTENSIONS : CONSOMMER DES SERVICES AVEC RX PARTIE 3, LES PIèGES à éVITER par Groc

SHAREPOINT BLOG SITE, PROBLèME D'ARCHIVES par junarnoalg

Forum

RE : PROBLèME PROVIDER POUR ACCéDER AUX BASES ACCES AVEC ADO par acive

PROBLEME AVEC CRYSTAL REPORT par youness03X

RE : PROBLèME PROVIDER POUR ACCéDER AUX BASES ACCES AVEC ADO par zizoweb

RE : LISTBOX ET CASES à COCHER par cmarcotte

RE : VISUAL BASIC 2010: COLLER DES DONNéS COPIER D'UN COLONNE D'UN FICHIER EXEL DANS UN COLONNE DE DATAGRIDVIEW par cmarcotte

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Realisation d-une version 2 d-un site e-commerce existant sous prestashop-REPUBLICATION
Budget : 5 000€
Recherche Infogerance Serveur Debian Linux
Budget : 1 800€
Creation d-un site vitrine avec MagentO
Budget : 2 000€

Logiciels

sDEVIS-FACTURES vlPRO (8.1.0.3)
SDEVIS-FACTURES VLPRO (8.1.0.3)

sDEVIS-FACTURES vlPRO a été mis au point pour les particuliers, créateurs, entrepreneurs, artisa...

Cliquez pour télécharger sDEVIS-FACTURES vlPRO
974 Application Server (12.2.4.6)
974 APPLICATION SERVER (12.2.4.6)

Développez de puissantes applications dans un environnement de 'cloud computing', clusterisé, séc...

Cliquez pour télécharger 974 Application Server
vPicture (1.4.2.1)
VPICTURE (1.4.2.1)

Avec vPicture, hébergez vos images facilement et rapidement. vPicture est un utilitaire simple, ...

Cliquez pour télécharger vPicture
Easy-Planning (2.2.1.6)
EASY-PLANNING (2.2.1.6)

Easy-Planning permet de créer des plannings sous la représentation de diagrammes et est adapté au...

Cliquez pour télécharger Easy-Planning
COM-BACKUP (2.0)
COM-BACKUP (2.0)

COM-BACKUP est un logiciel de sauvegarde qui permet de planifier les sauvegardes de vos dossiers ...

Cliquez pour télécharger COM-BACKUP