le jeu du moulin sur vbaRésolu

Question

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

cs_bipou · Accepted Answer

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

cs_bipou · Answer

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 ?

nunuss · Answer

pour le déplacer de 1 à 2 ou 10 ca irait ca??

if case1.pion1.move
then pion1= case2 or case10

nunuss · Answer

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

nunuss · Answer

es ce que possibilité ou case_depart je dois les déclarer dans un module?

merci beaucoup

cs_bipou · Answer

bonjour
pourrais-tu envoyer ta source ?
je pourrais y répondre plus facilement

nunuss · Answer

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

cs_bipou · Answer

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

nunuss · Answer

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

cs_bipou · Answer

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

nunuss · Answer

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

Le jeu du moulin sur vba

11 réponses

Votre réponse

Discussions similaires