Probleme de simulation VB6

Version imprimable

17/05/2007, 15h11
souska

Probleme de simulation VB6

Bonjour a tous,

Je suis un débutant en VB, et je travaille sur un projet de simulation d'une segregation d'un damier,que je rend mardi soir, et comme je bloque je demande votre precieuse aide.

Pour eviter de remplir la page par le sujet, je l'ai mis sur un ftp sur l'adresse suivant: http://rohban.free.fr/vb6/vb6.rtf

Pour le moment j'ai reussi a initialiser le DAMIER, et a fair apparaitre les agents d'une facons aléatoire, et j'ai resussi a définir les nombre de voisins de la meme couleur ou pas. Pour savoir la satisfaction d'un agent (agent satisfait = au moins 4 voisins du meme couleur)

Mais j'ai un problème, c'est que le Damier est fait de 18 Agents en ligne et 18 en colone, et j'arrive pas a definir que les voisins d'un agent situer dans la première ligne ou colone et dans la dernière ligne ou colone. c'est a dire, pour les angles on aura comme une cylindre c.a.d que les voisins sont a l'opposer.

Et aussi pour eviter de taper tout le code, je l'ai mis sur le lien suivant : http://rohban.free.fr/vb6/code.rtf

La fonction dont je verifie les voisins est la suivante :

Citation:

Envoyé par fonction

Private Function LesVoisins(ByVal Ind As Integer) As Integer
Dim col As Integer
Dim lig As Integer
Dim CouleurInd As Long
col = colonne(Ind)
lig = ligne(Ind)
CouleurInd = agent(Ind).BackColor
'MsgBox "INDICE: " & Ind & " COONNE: " & Col & " LIGNE:" & Lig
If MemeCouleur(lig + 1, col + 1, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig + 1, col, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig + 1, col - 1, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig - 1, col + 1, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig - 1, col, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig - 1, col - 1, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig, col + 1, CouleurInd) Then LesVoisins = LesVoisins + 1
If MemeCouleur(lig, col - 1, CouleurInd) Then LesVoisins = LesVoisins + 1

End Function

merci d'avance pour votre aide...

Souska

Si on appelle x et y les coordonnées de la case que tu veux tester, tu peux faire comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 Dim CheckX As Byte, CheckY As Byte
Dim i As Byte, j As Byte
 
For i = x - 1 To x + 1
  For j = y - 1 To y + 1
    CheckX = i
    CheckY = j
    If CheckX = 0 Then CheckX = 18
    If CheckX = 19 Then CheckX = 1
    If CheckY = 0 Then CheckY = 18
    If CheckY = 19 Then CheckY = 1
    If CheckX <> x Or CheckY <> y Then
      'On ne teste pas si on compare à la case centrale évidemment
      If MemeCouleur(CheckX, CheckY, CouleurInd) Then LesVoisins = LesVoisins + 1
    End If
  Next j
Next i

17/05/2007, 15h54
souska

merci pour ta reponse mais j'esseye de tourner ta solution de toute les facon et l'adapter a mon code et ca marche pas :( :(

en fait on travail sur des agents qui sont definit chacun par un indice qui correspondant à la position (lig, col)

on voi ca dans le code suivant ( que j'ai mis sur le lien dans la parti du module) :

Citation:

Option Explicit
'le nbre de cases du damier, en largeur et hauteur
Public Const dimterrain = 19
'informations sur chaque agent du terrain
Public damier(1 To dimterrain, 1 To dimterrain) As Integer

Public Function ligne(ByVal indice As Integer) As Integer
'retourne la ligne correspondant à ind
ligne = ((indice - 1) Mod dimterrain) + 1
End Function

Public Function colonne(ByVal indice As Integer) As Integer
'reourne la colonne correspondant à indice
colonne = ((indice - 1) \ dimterrain) + 1
End Function

Public Function indice(ByVal lig As Integer, ByVal col As Integer) As Integer
'retourne l'indice correspondant à la position (lig, col)
indice = lig + (col - 1) * dimterrain
End Function