'Déclaration des variables
Dim converge As Boolean
Dim virtueltab(1 To 100, 1 To 100) As Byte 'Tableau de transition
Dim vietab(1 To 100, 1 To 100) As Byte 'Tableau initial
Dim n As Integer 'Effectif de départ
Dim pauser As Boolean
Dim evol As Integer
Dim i As Integer 'Compteur des lignes du tableau initial
Dim j As Integer 'Compteur des colonnes du tableau initial
Dim l As Integer 'Compteur des lignes du tableau de transition
Dim m As Integer 'Compteur des colonnes du tableau de transition
Dim k As Integer 'Nombre de cellules voisines pour une cellule
Dim b As Integer 'Contrainte fixée par l'utilisateur
Dim popu As Integer
Dim reponse As VbMsgBoxResult
 
 
'Procédure initialisation
Sub initialisation(ByRef x() As Byte)
Dim i, j As Integer
'Remplissage du tableau avec des 0
For i = 1 To 100
    For j = 1 To 100
        x(i, j) = 0
    Next
Next
End Sub
 
'Procédure remplir
Sub remplir(ByVal n As Integer, ByRef x() As Byte)
Dim i, j, m As Integer
 
'Remplissage aléatoire du tableau: boucle répéter jusqu'à ce que les cases du tableau prennent la valeur 1, et ceci n fois
Randomize
For m = 1 To n
    Do
        i = Int(99 * Rnd) + 1
        j = Int(99 * Rnd) + 1
    Loop Until x(i, j) = 0
    x(i, j) = 1
Next
End Sub
         
'Fonction comptage
Function comptage(ByRef x() As Byte, ByVal i As Integer, ByVal j As Integer) As Integer
Dim l, c, n As Integer
Dim imin, imax, jmin, jmax As Integer
 
n = 0 'Initialisation du compteur
 
'Détermination des bornes du tableau dans un univers restreint
imin = i - 1
imax = i + 1
jmin = j - 1
jmax = j + 1
 
'Comptage dans les coins
If i = 1 Then
    imin = 1
Else
    If i = 100 Then
        imax = 100
    End If
End If
 
If j = 1 Then
    jmin = 1
Else
    If j = 100 Then
        jmax = 100
    End If
End If
 
'Comptage des futures cellules affichées
For l = imin To imax
    For c = jmin To jmax
        If x(l, c) = 1 Then
            n = n + 1
        End If
    Next
Next
 
If x(i, j) = 1 Then
    n = n - 1
End If
comptage = n
 
End Function
 
'Procédure dessiner
Sub dessiner(ByRef x() As Byte)
Dim l, c As Integer
For l = 1 To 100
    For c = 1 To 100
        If x(l, c) = 1 Then
            Picture1.FillStyle = 0 'Remplissage plein de la cellule vivante
            Picture1.FillColor = QBColor(4) 'Remplissage de couleur rouge de la cellule vivante
            Picture1.Circle (50 * l, 50 * c), 25, QBColor(4)
        Else
            Picture1.FillStyle = 0.01 'Remplissage plein de la cellule morte
            Picture1.FillColor = QBColor(15) 'Remplissage de couleur blanche de la cellule morte
            Picture1.Circle (50 * l, 50 * c), 25, QBColor(15) 'Couleur et forme de la cellule morte
        End If
         
        Picture1.AutoRedraw = True 'Rafraîchissement de l'image
         
    Next
Next
Refresh
End Sub
 
'Fonction evolution
Function evolution(ByRef x() As Byte, ByRef y() As Byte, ByVal i, j, b, k As Integer) As Integer
Dim c As Integer
c = 0
 
'k est le nombre de voisins autour de la cellule
If k = b + 1 Then
    If x(i, j) = 1 Then
        y(i, j) = 1
    Else
        y(i, j) = 1
        c = c + 1
    End If
End If
 
'Fonction de comptage des voisins en tenant compte des la contrainte b
If k = b Then
    If x(i, j) = 1 Then
        y(i, j) = 1
    Else
        y(i, j) = 0
    End If
End If
 
'Cas de la cellule seule ou entourée de plus de trois cellules: elle meurt dans virtueltab
If k < b Or k > b + 1 Then
    If x(i, j) = 1 Then
        y(i, j) = 0
        c = c + 1
    Else
        y(i, j) = 0
    End If
End If
 
'vietab reçoit les modifications effectuées dans virtueltab
x(i, j) = y(i, j)
evolution = c
End Function
 
'Fonction comptevol: comptage post évolution
Function comptevol(ByRef x() As Byte)
Dim i, j As Integer
Dim c As Integer
 
c = 0
For i = 1 To 100
    For j = 1 To 100
        If x(i, j) = 1 Then
            c = c + 1
        End If
    Next
Next
 
comptevol = c
End Function
 
Private Sub Bgo_Click()
 
'Algorithme principal
 
'Appel de la procédure de création du tableau
Call initialisation(vietab)
 
'On demande à l'utilisateur de définir un effectif de départ
If Teffectif.Text = "" Then
    n = InputBox("Effectif de départ?" )
    Teffectif.Text = n
Else
    n = Teffectif.Text
End If
 
'Choix de la contrainte
If Tcontrainte.Text = "" Then
    b = InputBox("Choix d'une contrainte entre 1 et 4" )
    Tcontrainte.Text = b
Else
    b = Tcontrainte.Text
End If
 
 
'Appel de la procédure de remplissage par randomisation
Call remplir(n, vietab)
 
'Appel de la procédure de dessin des cellules
Call dessiner(vietab)
 
evol = 0
For i = 1 To 100
    For j = 1 To 100
        'Appel de la fonction comptage, k reçoit sa valeur de sortie
        k = comptage(vietab, i, j)
        'Mise en correspondance des 2 tableaux
        c = evolution(vietab, virtueltab, i, j, b, k)
        evol = evol + c
    Next
Next
 
'La valeur de convergence est atteinte lorsqu'il n'y a plus d'écart entre les 2 tableaux
converge = evol = 0
 
'Somme des cellules vivantes
popu = comptevol(vietab)
 
'Dessin des valeurs contenues dans vietab
Call dessiner(vietab)
 
'Pause dans la boucle
Do
DoEvents
'Fin de la boucle si convergence au pause
Loop Until converge Or pauser
 
End Sub
 
 
 
 
 
 
 
 
 
Private Sub Bquitter_Click()
End
End Sub