Posez votre question Signaler

Le jeu du moulin sur vba [Résolu]

Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
 - - Dernière réponse : nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
 - 23 juin 2006 à 10:54
VB.NET Posez votre question Signaler
hello à tous,
je fais le jeu du moulin sur vba mais j'ai quelques problèmes..

quel serait le code afin de pouvoir déplacer un pion d'une case à l'autre..cependant un pion ne peut pas se déplacer sur toutes les cases occupées par un autre pion et sur certaine cases non accessibles.
voici le tableau des déplacements possibles à partir d'un pion(1ere colonne):
par exemple le pion 1 peut se déplacer sur la case 2 ou 10 si elles ne sont pas occupées.Si elles sont occupées impossible de sauter les cases 2 et 10 ou de les écraser. le pions ne peut donc pas bouger....

merci infiniment de vos réponses et de vos codes....


<colgroup>
<col style=\"WIDTH: 48pt; mso-width-source: userset; mso-width-alt: 2340\" span=\"5\" width=\"64\" />
</colgroup>

----

1
,
2,
10,
 ,
 ,

----

2
,
1,
3,
5,
 ,

----

3
,
2,
15,
 ,
 ,

----

4
,
5,
11,
 ,
 ,

----

5
,
2,
4,
6,
8,

----

6
,
5,
14,
 ,
 ,

----

7
,
8,
12,
 ,
 ,

----

8
,
5,
7,
9,
 ,

----

9
,
8,
13,
 ,
 ,

----

10
,
1,
22,
 ,
 ,

----

11
,
4,
10,
12,
19,

----

12
,
7,
11,
16,
 ,

----

13
,
9,
14,
18,
 ,

----

14
,
6,
13,
15,
21,

----

15
,
3,
14,
24,
 ,

----

16
,
12,
17,
 ,
 ,

----

17
,
16,
18,
20,
 ,

----

18
,
13,
17,
 ,
 ,

----

19
,
11,
20,
 ,
 ,

----

20
,
17,
19,
21,
23,

----

21
,
14,
20,
 ,
 ,

----

22
,
10,
23,
 ,
 ,

----

23
,
20,
22,
24,
 ,

----

24
,
15,
23,
 ,
 
Afficher la suite 

Votre réponse

Répondre au sujet

11 réponses

Meilleure réponse
Signaler Commenter la réponse de cs_bipou
Messages postés
61
Date d'inscription
mercredi 14 janvier 2004
Dernière intervention
14 septembre 2006
3
Merci
heu .... moi y en a pas connaitre ces objets là !
il serait bon de définir plusieurs choses avant de poser une question :
- définir le système sur lequel on travaille : VBA c'est encore vague (excel word, access, ...
- etre beaucoup plus précis dans les questions :
. qu'est-ce que tu as (cellules/controle,feuille excel/formulaire,...
. pour quel résultat

bon
dans le cas ou la liste des possiblité est fixe
je passerai par une fonction de ce type la:

function possibilite(case_depart as integer) as string
select case case_depart
case 1 : possibilite="2;10"
case 2 : possibilite="1;3;5"
...
...
case 24 : possibilite="15;23"
end select
end function

ce qui me renvoie une chaine que je peux convertir en tableau (split) des cases autorisées

Merci cs_bipou 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de cs_bipou
Signaler Commenter la réponse de cs_bipou
Messages postés
61
Date d'inscription
mercredi 14 janvier 2004
Dernière intervention
14 septembre 2006
3
Merci
j'ai deux solutions :
- je te donne le code (bof)
- je te dis ce qu'il faut faire sans le code (je préfére)

d'abord rajouter à ton type "tcaseMoulin" une donnée image (pour savoir quel n°image se trouve dessus) et une donnée propriétaire (qui est dessus)

j'ai rajouté aussi la chaine des triplés de cases gagnantes
Public Const str_gagne= "1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21;22;23;24;1;10;22;4;11;19;7;12;16;2;5;8;17;20;23;9;13;18;6;14;21;3;15;24"

pour pouvoir revenir en arrière, il faut sauvegarder les coordonnées origines de l'image que tu déplaces. (événement mouse_down)

dans l'événement mouse_up, il faut:
savoir de quel case provient le pion déplacé
savoir sur quel case il veut aller (ca c'est déjà fait)
savoir si la case est libre (c'est pour cela qu'il faut modifier ton type "tcaseMoulin")
savoir si le déplacement est autorisé (j'utilise ainsi la fonction que je t'ai déj envoyé) :
tab_poss = Split(possibilite(case_origine), ";")
For intJ = LBound(tab_poss) To UBound(tab_poss)
If tab_poss(intJ) intMin Then ok True
Next

si on n'a pas tout ca, on on revient aux coordonées de l'origine
sinon, on déplace puis on vérifie si on a un alignement
Function verif_gagne(joueur As Byte) As Boolean
Dim i As Integer
Dim c1 As Integer, c2 As Integer, c3 As Integer
Dim tab_gagne As Variant
verif_gagne = False
tab_gagne = Split(str_gagne, ";")
For i = LBound(tab_gagne) To UBound(tab_gagne) Step 3
c1 = arrcoorTableau(tab_gagne(i)).qui
c2 = arrcoorTableau(tab_gagne(i + 1)).qui
c3 = arrcoorTableau(tab_gagne(i + 2)).qui
If c1 c2 And c2 c3 And c1 = joueur Then verif_gagne = True: Exit For
Next
End Function

Merci cs_bipou 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de cs_bipou
Signaler Commenter la réponse de cs_bipou
Messages postés
61
Date d'inscription
mercredi 14 janvier 2004
Dernière intervention
14 septembre 2006
3
Merci
j'ai modifié:



Type tcaseMoulin
    coorX As Integer
    coorY As Integer
    qui As Integer      'ajout bipou
    imag As Byte        'ajout bipou
E
nd Type



Type coor               'ajout bipou
    coorX As Integer    'ajout bipou
    coorY As Integer    'ajout bipou
End Type                'ajout bipou



Public imag_orig As coor    'ajout bipou



j'ai modifié:








Private Sub Image5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    imag_orig.coorX = Image5.Left
    imag_orig.coorY = Image5.Top
End Sub






j'ai modifié


Sub MouseUp(NbImage As Byte)
   
    Dim intMin As Integer
    Dim intMinDist As Long
    Dim intI As Integer
    Dim intJ As Integer     'ajout bipou
    Dim ok As Boolean       'ajout bipou
    Dim tab_poss As Variant 'ajout bipou
    Dim origine As Byte     'ajout bipou
    origine = 0             'ajout bipou
    ok = False              'ajout bipou
 
    If (intJoueur = 1 And NbImage >= 5 And NbImage <= 13) Or _
       (intJoueur = 2 And NbImage >= 14 And NbImage <= 22) Then
       
        For intI = 1 To 24                                              'ajout bipou            If arrcoorTableau(intI).imag NbImage Then origine intI  'ajout bipou
        Next                                                            'ajout bipou
       
        intMin = 0
        intMinDist = 9999999#
       
        For intI = 1 To 24
            If intMinDist > Sqr((arrcoorTableau(intI).coorX - Me.Controls("Image" & NbImage).Left) ^ 2 + (arrcoorTableau(intI).coorY - Me.Controls("Image" & NbImage).Top) ^ 2) Then
                intMin = intI
                intMinDist = Sqr((arrcoorTableau(intI).coorX - Me.Controls("Image" & NbImage).Left) ^ 2 + (arrcoorTableau(intI).coorY - Me.Controls("Image" & NbImage).Top) ^ 2)
           End If
        Next
       
        If arrcoorTableau(intMin).qui <> 0 Then                         'ajout bipou
            Me.Controls("Image" & NbImage).Move imag_orig.coorX, imag_orig.coorY 'ajout bipou
            Exit Sub                                                'ajout bipou
        End If                                                          'ajout bipou
        If origine = 0 Then                                             'ajout bipou
            ok = True                                                   'ajout bipou
        Else                                                            'ajout bipou
            tab_poss = Split(possibilite(origine), ";")                 'ajout bipou
            For intJ = LBound(tab_poss) To UBound(tab_poss)             'ajout bipou                If tab_poss(intJ) intMin Then ok True               'ajout bipou
            Next                                                        'ajout bipou
        End If                                                          'ajout bipou
        If ok Then                                                      'ajout bipou
            arrcoorTableau(intMin).qui = intJoueur                      'ajout bipou
            arrcoorTableau(intMin).imag = NbImage                       'ajout bipou
            Me.Controls("Image" & NbImage).Left = arrcoorTableau(intMin).coorX
            Me.Controls("Image" & NbImage).Top = arrcoorTableau(intMin).coorY            If origine <> 0 Then arrcoorTableau(origine).qui 0: arrcoorTableau(origine).imag 0  'ajout bipou
'                    MsgBox Moulin(intMin)
           
            If verif_gagne(intJoueur) Then MsgBox "Joueur " & intJoueur & " a gagné": End           'ajout bipou
            If intJoueur = 1 Then
                intJoueur = 2
            Else
                intJoueur = 1
            End If
        Else
            Me.Controls("Image" & NbImage).Move imag_orig.coorX, imag_orig.coorY 'ajout bipou
        End If
    End If
    Me.TextBox1 = Me.Controls("TextBox" & 1 + intJoueur)
End Sub








j'ai modifié


function possibilite(case_depart as byte) as string





j'ai ajouté




Function verif_gagne(joueur As Byte) As Boolean             'ajout bipou
    Dim i As Integer                                        'ajout bipou
    Dim c1 As Integer, c2 As Integer, c3 As Integer         'ajout bipou
    Dim tab_gagne As Variant                                'ajout bipou
    verif_gagne = False                                     'ajout bipou
    tab_gagne = Split(str_gagne, ";")                       'ajout bipou
    For i = LBound(tab_gagne) To UBound(tab_gagne) Step 3   'ajout bipou
        c1 = arrcoorTableau(tab_gagne(i)).qui               'ajout bipou
        c2 = arrcoorTableau(tab_gagne(i + 1)).qui           'ajout bipou
        c3 = arrcoorTableau(tab_gagne(i + 2)).qui           'ajout bipou        If c1 c2 And c2 c3 And c1 = joueur Then         'ajout bipou
            verif_gagne = True                              'ajout bipou
            Exit For                                        'ajout bipou
        End If                                              'ajout bipou
    Next                                                    'ajout bipou
End Function                                                'ajout bipou

Merci cs_bipou 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de cs_bipou
Signaler Commenter la réponse de cs_bipou
Messages postés
61
Date d'inscription
mercredi 14 janvier 2004
Dernière intervention
14 septembre 2006
0
Merci
bonjour,

on veut bien t'aider mais il n'est pas question de faire à ta place !

quel est ton problème du point de vue programmation ?
Commenter la réponse de cs_bipou
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
pour le déplacer de 1 à 2 ou 10 ca irait ca??

if case1.pion1.move
then pion1= case2 or case10
Commenter la réponse de nunuss
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
le programme est sur vba excel...le tableau du dessus est une sur ma sheet3...
j'ai un frmtabledejeux sur lequel le jeu tourne...
le but du jeu est d'éliminer les pions adverses en faisant un moulin(charret)...les pions sont des simples images qu'on peut déplacer mais pour l'instant sur n'importe quelle autre case..le problème c'est que je ne sais pas comment faire pour que le pion se déplace seulement d'après les choix de cases du tableau défini sur excel...depplus un pions ne peut pas écraser un autre pion et il est impossible de sauter par dessus...
d'après la liste fixe que tu donne comment es ce que vba sait que c'est une liste sur ma page 3 d'excel?

en tout cas merci beaucoup de ton aide...

bonne journée
Commenter la réponse de nunuss
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
es ce que possibilité ou case_depart je dois les déclarer dans un module?

merci beaucoup
Commenter la réponse de nunuss
Signaler Commenter la réponse de cs_bipou
Messages postés
61
Date d'inscription
mercredi 14 janvier 2004
Dernière intervention
14 septembre 2006
0
Merci
bonjour
pourrais-tu envoyer ta source ?
je pourrais y répondre plus facilement
Commenter la réponse de cs_bipou
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
c'est ca les sources??
merci du coups de main

ca c'est pour mon frmtable:

Option Explicit


Private Sub CommandButton1_Click()
 FrmTable.Hide
 FrmPerso.Show
End Sub


Private Sub CommandButton2_Click()
 FrmTable.Hide
 
End Sub


Private Sub Image26_Click()


End Sub


Private Sub imgJoueur1Fr_Click()


End Sub


Private Sub imgJoueur2F_Click()


End Sub


Private Sub UserForm_Click()
   
End Sub


Private Sub UserForm_Initialize()


Dim intI As Integer


tableau
intJoueur = 1


Select Case choixA
    Case 1
        Me.imgJoueur1F.Visible = True
        Me.imgJoueur1B.Visible = False
        Me.imgJoueur1Fr.Visible = False
        Me.imgJoueur1R.Visible = False
        Me.TextBox2.Value = "FLIPPER"
        Me.LabelJoueur1.Caption = "FLIPPER"
       
        For intI = 5 To 13
            Me.Controls("image" & intI).Picture = Me.imgJoueur1F.Picture
        Next
       
    Case 4
        Me.imgJoueur1F.Visible = False
        Me.imgJoueur1B.Visible = False
        Me.imgJoueur1Fr.Visible = False
        Me.imgJoueur1R.Visible = True
        Me.TextBox2.Value = "RAMBO"
        Me.LabelJoueur1.Caption = "RAMBO"
       
        For intI = 5 To 13
            Me.Controls("image" & intI).Picture = Me.imgJoueur1R.Picture
        Next
    Case 2
        Me.imgJoueur1F.Visible = False
        Me.imgJoueur1B.Visible = False
        Me.imgJoueur1Fr.Visible = True
        Me.imgJoueur1R.Visible = False
        Me.TextBox2.Value = "FRANKY"
        Me.LabelJoueur1.Caption = "FRANKY"
       
        For intI = 5 To 13
            Me.Controls("image" & intI).Picture = Me.imgJoueur1Fr.Picture
        Next
    Case 3
        Me.imgJoueur1F.Visible = False
        Me.imgJoueur1B.Visible = True
        Me.imgJoueur1Fr.Visible = False
        Me.imgJoueur1R.Visible = False
        Me.TextBox2.Value = "BIQUETTE"
        Me.LabelJoueur1.Caption = "BIQUETTE"
       
        For intI = 5 To 13
            Me.Controls("image" & intI).Picture = Me.imgJoueur1B.Picture
        Next
End Select




Select Case choixB
    Case 1
        Me.imgJoueur2F.Visible = True
        Me.imgJoueur2B.Visible = False
        Me.imgJoueur2Fr.Visible = False
        Me.imgJoueur2R.Visible = False
        Me.TextBox3.Value = "FLIPPER"
        Me.LabelJoueur2.Caption = "FLIPPER"
       
        For intI = 14 To 22
            Me.Controls("image" & intI).Picture = Me.imgJoueur2F.Picture
        Next
       
    Case 4
        Me.imgJoueur2F.Visible = False
        Me.imgJoueur2B.Visible = False
        Me.imgJoueur2Fr.Visible = False
        Me.imgJoueur2R.Visible = True
        Me.TextBox3.Value = "RAMBO"
        Me.LabelJoueur2.Caption = "RAMBO"
       
        For intI = 14 To 22
            Me.Controls("image" & intI).Picture = Me.imgJoueur2R.Picture
        Next
    Case 2
        Me.imgJoueur2F.Visible = False
        Me.imgJoueur2B.Visible = False
        Me.imgJoueur2Fr.Visible = True
        Me.imgJoueur2R.Visible = False
        Me.TextBox3.Value = "FRANKY"
        Me.LabelJoueur2.Caption = "FRANKY"
       
        For intI = 14 To 22
            Me.Controls("image" & intI).Picture = Me.imgJoueur2Fr.Picture
        Next
    Case 3
        Me.imgJoueur2F.Visible = False
        Me.imgJoueur2B.Visible = True
        Me.imgJoueur2Fr.Visible = False
        Me.imgJoueur2R.Visible = False
        Me.TextBox3.Value = "BIQUETTE"
        Me.LabelJoueur2.Caption = "BIQUETTE"
       
        For intI = 14 To 22
            Me.Controls("image" & intI).Picture = Me.imgJoueur2B.Picture
        Next
End Select




End Sub


Private Sub Image10_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 10, (x), (y), Button
End Sub


Private Sub Image10_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 10
End Sub


Private Sub Image11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 11, (x), (y), Button
End Sub


Private Sub Image11_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 11
End Sub


Private Sub Image12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 12, (x), (y), Button
End Sub


Private Sub Image12_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 12
End Sub


Private Sub Image13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 13, (x), (y), Button
End Sub


Private Sub Image13_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 13
End Sub


Private Sub Image14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 14, (x), (y), Button
End Sub


Private Sub Image14_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 14
End Sub


Private Sub Image15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 15, (x), (y), Button
End Sub


Private Sub Image15_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 15
End Sub


Private Sub Image16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 16, (x), (y), Button
End Sub


Private Sub Image16_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 16
End Sub


Private Sub Image17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 17, (x), (y), Button
End Sub


Private Sub Image17_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 17
End Sub


Private Sub Image18_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 18, (x), (y), Button
End Sub


Private Sub Image18_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 18
End Sub


Private Sub Image19_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 19, (x), (y), Button
End Sub


Private Sub Image19_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 19
End Sub


Private Sub Image20_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 20, (x), (y), Button
End Sub


Private Sub Image20_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
     MouseUp 20
End Sub


Private Sub Image21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 21, (x), (y), Button
End Sub


Private Sub Image21_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 21
End Sub


Private Sub Image22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 22, (x), (y), Button
End Sub


Private Sub Image22_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 22
End Sub


Private Sub Image5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseMove 5, (x), (y), Button
End Sub


Private Sub Image5_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 5
End Sub


Private Sub Image6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseMove 6, (x), (y), Button
End Sub


Private Sub Image6_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
     MouseUp 6
End Sub


Private Sub Image7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    MouseMove 7, (x), (y), Button
End Sub


Private Sub Image7_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
      MouseUp 7
End Sub


Private Sub Image8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    MouseMove 8, (x), (y), Button
End Sub


Private Sub Image8_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
       MouseUp 8
End Sub


Private Sub Image9_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    MouseMove 9, (x), (y), Button
End Sub


Private Sub Image9_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    MouseUp 9
End Sub


Private Sub Label1_Click()


End Sub


Private Sub Label2_Click()


End Sub


Private Sub TextBox1_()


End Sub


Private Sub TextBox1_Change()


End Sub


Private Sub TextBox2_Change()
 
End Sub


Private Sub TextBox3_Change()


End Sub




Private Sub tableau()


arrcoorTableau(1).coorX = 0
arrcoorTableau(1).coorY = 0
arrcoorTableau(2).coorX = 198
arrcoorTableau(2).coorY = 0
arrcoorTableau(3).coorX = 402
arrcoorTableau(3).coorY = 0
arrcoorTableau(4).coorX = 60
arrcoorTableau(4).coorY = 60
arrcoorTableau(5).coorX = 198
arrcoorTableau(5).coorY = 60
arrcoorTableau(6).coorX = 336
arrcoorTableau(6).coorY = 60
arrcoorTableau(7).coorX = 126
arrcoorTableau(7).coorY = 132
arrcoorTableau(8).coorX = 198
arrcoorTableau(8).coorY = 132
arrcoorTableau(9).coorX = 270
arrcoorTableau(9).coorY = 132
arrcoorTableau(10).coorX = 0
arrcoorTableau(10).coorY = 198
arrcoorTableau(11).coorX = 60
arrcoorTableau(11).coorY = 198
arrcoorTableau(12).coorX = 126
arrcoorTableau(12).coorY = 198
arrcoorTableau(13).coorX = 270
arrcoorTableau(13).coorY = 198
arrcoorTableau(14).coorX = 336
arrcoorTableau(14).coorY = 198
arrcoorTableau(15).coorX = 402
arrcoorTableau(15).coorY = 198
arrcoorTableau(16).coorX = 126
arrcoorTableau(16).coorY = 270
arrcoorTableau(17).coorX = 198
arrcoorTableau(17).coorY = 270
arrcoorTableau(18).coorX = 270
arrcoorTableau(18).coorY = 270
arrcoorTableau(19).coorX = 60
arrcoorTableau(19).coorY = 336
arrcoorTableau(20).coorX = 198
arrcoorTableau(20).coorY = 336
arrcoorTableau(21).coorX = 336
arrcoorTableau(21).coorY = 336
arrcoorTableau(22).coorX = 0
arrcoorTableau(22).coorY = 408
arrcoorTableau(23).coorX = 198
arrcoorTableau(23).coorY = 408
arrcoorTableau(24).coorX = 402
arrcoorTableau(24).coorY = 408




End Sub


Sub MouseMove(NbImage As Byte, x As Integer, y As Integer, b As Integer)


    Dim centreX As Single
    Dim centreY As Single
       
    If (intJoueur = 1 And NbImage >= 5 And NbImage <= 13) Or _
       (intJoueur = 2 And NbImage >= 14 And NbImage <= 22) Then
   
        If b = 1 Then
            centreX = Me.Controls("Image" & NbImage).Width / 2
            centreY = Me.Controls("Image" & NbImage).Height / 2
           
            Me.Controls("Image" & NbImage).Left = Me.Controls("Image" & NbImage).Left + (x - centreX)
            Me.Controls("Image" & NbImage).Top = Me.Controls("Image" & NbImage).Top + (y - centreY)
        End If
   
    Else
        ' mauvais pion
    End If


End Sub


Sub MouseUp(NbImage As Byte)
   
    Dim intMin As Integer
    Dim intMinDist As Long
    Dim intI As Integer
 
    If (intJoueur = 1 And NbImage >= 5 And NbImage <= 13) Or _
       (intJoueur = 2 And NbImage >= 14 And NbImage <= 22) Then
 
        intMin = 0
        intMinDist = 9999999#
       
        For intI = 1 To 24
            If intMinDist > Sqr((arrcoorTableau(intI).coorX - Me.Controls("Image" & NbImage).Left) ^ 2 + (arrcoorTableau(intI).coorY - Me.Controls("Image" & NbImage).Top) ^ 2) Then
                intMin = intI
                intMinDist = Sqr((arrcoorTableau(intI).coorX - Me.Controls("Image" & NbImage).Left) ^ 2 + (arrcoorTableau(intI).coorY - Me.Controls("Image" & NbImage).Top) ^ 2)
            End If
        Next
       
        Me.Controls("Image" & NbImage).Left = arrcoorTableau(intMin).coorX
        Me.Controls("Image" & NbImage).Top = arrcoorTableau(intMin).coorY
       
        MsgBox Moulin(intMin)
       
        If intJoueur = 1 Then
            intJoueur = 2
        Else
            intJoueur = 1
        End If
       
    Else
    End If


End Sub


Function VerifieCase(bytCase As Byte) As Byte
    Dim i As Integer


    VerifieCase = cvide


    For i = 5 To 13
        If Me.Controls("Image" & i).Left = arrcoorTableau(bytCase).coorX And _
           Me.Controls("image" & i).Top = arrcoorTableau(bytCase).coorY Then
            VerifieCase = cJoueur1
        End If
    Next


    For i = 14 To 22
        If Me.Controls("Image" & i).Left = arrcoorTableau(bytCase).coorX And _
           Me.Controls("image" & i).Top = arrcoorTableau(bytCase).coorY Then
            VerifieCase = cJoueur2
        End If
    Next


End Function


Function Moulin(bytBut) As Byte
    Dim i As Integer
    Moulin = cvide


    For i = 5 To 20
        If ThisWorkbook.Sheets("Sheet3").Cells(i, 10) = bytBut Or _
           ThisWorkbook.Sheets("Sheet3").Cells(i, 11) = bytBut Or _
           ThisWorkbook.Sheets("Sheet3").Cells(i, 12) = bytBut Then
          
           If VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 10)) = cJoueur1 And _
              VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 11)) = cJoueur1 And _
              VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 12)) = cJoueur1 Then
                Moulin = cJoueur1
                         
               
           End If
        End If
    Next


    For i = 5 To 20
        If ThisWorkbook.Sheets("Sheet3").Cells(i, 10) = bytBut Or _
           ThisWorkbook.Sheets("Sheet3").Cells(i, 11) = bytBut Or _
           ThisWorkbook.Sheets("Sheet3").Cells(i, 12) = bytBut Then
          
           If VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 10)) = cJoueur2 And _
              VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 11)) = cJoueur2 And _
              VerifieCase(ThisWorkbook.Sheets("Sheet3").Cells(i, 12)) = cJoueur2 Then
                Moulin = cJoueur2
           End If
        End If
    Next




End Function


Function possibilite(case_depart As Integer) As String
  Select Case case_depart
    Case 1: possibilite = "2;10"
    Case 2: possibilite = "1;3;5"
    Case 3: possibilite = "2;15"
    Case 4: possibilite = "5;11"
    Case 5: possibilite = "2;4;6;8"
    Case 6: possibilite = "5;14"
    Case 7: possibilite = "8;12"
    Case 8: possibilite = "5;7;9"
    Case 9: possibilite = "8;13"
    Case 10: possibilite = "1;22"
    Case 11: possibilite = "4;10;12;19"
    Case 12: possibilite = "7;11;16"
    Case 13: possibilite = "9;14;18"
    Case 14: possibilite = "6;13;15;21"
    Case 15: possibilite = "3;14;24"
    Case 16: possibilite = "12;17"
    Case 17: possibilite = "16;18;20"
    Case 18: possibilite = "13;17"
    Case 19: possibilite = "11;20"
    Case 20: possibilite = "17;19;21;23"
    Case 21: possibilite = "14;20"
    Case 22: possibilite = "10;23"
    Case 23: possibilite = "20;22;24"
    Case 24: possibilite = "15;23"
  End Select
End Function

dans mes modules j'ai mis ca:
module1:

Option Explicit


Public choixA As Byte
Public choixB As Byte
Public nbrclick As Byte
Public intJoueur As Byte


Public Const cvide = 0
Public Const cJoueur1 = 1
Public Const cJoueur2 = 2




Type tcaseMoulin
   
    coorX As Integer
    coorY As Integer


End Type




Public arrcoorTableau(1 To 24) As tcaseMoulin

dans mon module2:

Sub Teste()
'
' Teste Macro
' Macro recorded 06.06.2006 by nussfabi
'


'
    Sheets("Sheet2").Select
    ActiveSheet.Shapes("flipper").Select
    Selection.Copy
    Sheets("Sheet3").Select
    Range("C15").Select
    ActiveSheet.Paste
End Sub
Commenter la réponse de nunuss
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
merci infiniment du coups de main..j'ai encore 4 jours pour finir mon projet ca va etre court..je vais essayer ce que tu m as donné et j'espère que je vais y arriver....

pour les public les const et str gagné je dois les mettre dans un module? sous quel forme?
comment mets tu une image sur tmoulin?
cette partie: 
tab_poss = Split(possibilite(case_origine), ";")
            For intJ = LBound(tab_poss) To UBound(tab_poss)                If tab_poss(intJ) intMin Then ok True
            Next

va avec celle ci???:
function possibilite(case_depart as integer) as string
  select case case_depart
    case 1 : possibilite="2;10"
    case 2 : possibilite="1;3;5"
   ...
   ...
    case 24 : possibilite="15;23"
  end select
end function

vais essayer...merci
Commenter la réponse de nunuss
Signaler Commenter la réponse de nunuss
Messages postés
7
Date d'inscription
jeudi 15 juin 2006
Dernière intervention
23 juin 2006
0
Merci
merci infiniment pour ton aide...j'ai enfin pu finir le jeu meme si un bug de temps en temps mais rien de grave..juste que les moulins sont détectés sauf quelques fois..ton aide m'as été super utile...je te tire un grand coups de chapeau pour tes connaissances et surtout pour ta disponibilité...

ca fait plaisir de voir des gens comme toi qui aident les autres même des inconus...

bonne journée et encore merci infiniment

fabian, un suisse
Commenter la réponse de nunuss

Votre réponse

Répondre au sujet
Posez votre question
S'inscrire maintenant

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.