Mouvement d'un dé dans un UserForm

Question

Bonjour, J'essaie de rendre "réaliste" (on s'entend bien, ça n'est que du VBA...), le jet de dé et son déplacement au sein d'un UserForm. Je me heurte actuellement à deux problèmes : 1- par moment l'userform "bloque". Il reste figé comme lors d'un plantage Excel avec un message d'erreur dans son Caption (Ne répond pas...), puis m'affiche "l'image finale". Je pense que cela est du aux .Repaint en boucles... A voir. 2- Le dé ne respecte pas l'obstacle que représente le bord bas de l'UserForm. Il "déborde" vers le bas. Je n'ai pas ce souci avec les 3 autres bords (quoiqu'un léger souci avec le bord droit...). Ce problème est matérialisé, dans le code, par des commentaires : '///////////////////////SOUCI Pour vous rendre compte, par vous mêmes, vous pouvez, au choix, télécharger mon fichier exemple : sur cjoint.com, ou faire votre propre fichier. Dans un cas, comme dans l'autre, vous aurez besoin des images des dés (à renommer : 1.jpg, 2.jpg etc... 6.jpg) Pour faire votre propre fichier, dans un classeur vierge : - insérez un UserForm (propriété Name : "Piste") - dessinez y un contrôle Image (propriété Name : "ImageDe") Les codes : Module de l'UserForm : Option Explicit Dim StopIt As Boolean Private Sub UserForm_Initialize() With Me .Height = 700 .Width = 700 .BackColor = 32768 .Caption = "Piste de dés" With .ImageDe .Height = 24 .Width = 24 .Visible = False End With End With End Sub 'Pour calculer la force de lancer du dé (entre 1 et 100), le joueur doit maintenir le bouton gauche de la souris appuyé 'durant tout le temps ou ce bouton est maintenu (UserForm_MouseDown), la variable Force varie de 1 à 100 et de 100 à 1 'l'arrêt de cette procédure se fait en relachant le bouton (UserForm_MouseUp) 'la variable Boolean StopIt, déclarée en entête de ce module, combinée au DoEvents permet cet arrêt Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim i As Integer 'initialisation de la variable Force (à chaque clic dans l'UserForm) Force = 1 StopIt = False 'la variable i prends les valeurs uniques 1 & -1 'Elle sert donc à faire varier le "sens" d'incrémentation de la variable Force : 'quand i = 1, Force varie de 1 vers 100 'quand i = -1, Force varie de 100 vers 1 Do While StopIt = False Force = Force + (1 * i) If Force = 1 Then i = 1 If Force = 100 Then i = -1 DoEvents 'permet de déclencher l'événement Mouse_Up et donc de Stopper cette boucle Loop End Sub Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) StopIt = True Jeter_Les_Des End Sub Dans un module standard : Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Force As Integer Dim De_Left As Integer, De_Top As Integer Dim Coeff_Sens_Left As Double, Coeff_Sens_Top As Double Sub Jeter_Les_Des() Dim Tb(), i As Integer, Chemin As String, Cpt As Integer, Attente As Long 'Initialisation des variables Chemin = ThisWorkbook.Path & "" '=> Pour les images à afficher dans le contrôle ImageDe Randomize Timer ' => Tirages aléatoires Attente = 80 + (100 - Force) ' => Représente la vitesse initiale du dé Call Mouvements_Du_De(Tb()) ' Calcule et stocke toutes les positions du dés + ses valeurs For i = LBound(Tb, 2) To UBound(Tb, 2) ' Boucle sur toutes les positions prévues du dé 'ralenti le dé Cpt = Cpt + 1 If Cpt >= UBound(Tb, 2) / 10 Then Cpt = 0 Attente = Attente + 20 End If 'affiche l'image du dé With Piste With .ImageDe .Move Tb(1, i), Tb(2, i), 24, 24 .Visible = True .Picture = LoadPicture(Chemin & Tb(3, i) & ".jpg") .PictureSizeMode = fmPictureSizeModeStretch End With .Repaint End With Sleep Attente Next i End Sub 'Calcule et stocke toutes les positions du dés + ses valeurs 'Les données, stockées dans une variable tableau, sont : Left + Top + Valeur du dé Sub Mouvements_Du_De(ByRef Tbl()) Dim i As Integer, Valeur_Du_De As Byte, FinBoucle As Integer 'Si la force = 1, il n'y aura pas de mouvement. Le dé tombe sur la piste. 'Dans ce cas, on ne lance que la procédure Point_De_Chute_Du_De. If Force = 1 Then Call Point_De_Chute_Du_De(Tbl()) Exit Sub End If 'Point_De_Chute_Du_De => calcule aléatoirement ou va tomber le dé. Call Point_De_Chute_Du_De(Tbl()) 'Sens_Aleatoire => Calcule aléatoirement un coefficient Left et un coefficient Top 'Ces deux coefficients, multipliés à des constantes (en fonction de la force), 'nous donnent les coordonnées des emplacements du dé. Call Sens_Aleatoire 'Initialisation variable 'La force va diminuer au fur et à mesure de la boucle, on stocke donc sa valeur initiale. FinBoucle = Force For i = 2 To FinBoucle 'calcul des coordonnées de l'emplacement suivant, en fonction de l'emplacement actuel. De_Left = Tbl(1, i - 1) + (Force * 1.5) * Coeff_Sens_Left De_Top = Tbl(2, i - 1) + (Force * 1.5) * Coeff_Sens_Top '******************************************************************************************* A Faire. 'Apporter un coeff supplémentaire à une des deux "directions" pour donner un effet moins linéaire aux déplacements '******************************************************************************************* 'Permet de changer de sens lorsque le dé touche un des bords de la piste If De_Left < 0 Then Coeff_Sens_Left = Coeff_Sens_Left * -1 De_Left = 0 End If 'Pas de valeur numérique => permet de changer la taille de l'UserForm If De_Left >= Piste.Width - Piste.ImageDe.Width Then Coeff_Sens_Left = Coeff_Sens_Left * -1 De_Left = Piste.Width - Piste.ImageDe.Width '///////////////////////SOUCI "Léger" End If If De_Top < 0 Then Coeff_Sens_Top = Coeff_Sens_Top * -1 De_Top = 0 End If If De_Top >= Piste.Height - Piste.ImageDe.Height Then Coeff_Sens_Top = Coeff_Sens_Top * -1 De_Top = Piste.Height - Piste.ImageDe.Height '///////////////////////SOUCI "Important" End If '*******************************************************************************************A modifier. 'En fin de mouvement du dé, le dé roule et donc un 4 (par ex) ne peut pas être suivi : '- ni pas un 4 (dé glissé), '- ni par un 3 (situé sur l'autre face) Valeur_Du_De = CInt((5 * Rnd()) + 1) '******************************************************************************************* 'stockage des valeurs ReDim Preserve Tbl(1 To 3, 1 To i) Tbl(1, i) = De_Left Tbl(2, i) = De_Top Tbl(3, i) = Valeur_Du_De 'Baisse de la force => le dé va de moins en moins loin par rapport à sa position actuelle Force = CInt(Force - (Force / 20)) Next i End Sub Sub Point_De_Chute_Du_De(ByRef Tabl()) 'calcul aléatoire des 3 valeurs initiales du dé Erase Tabl ReDim Preserve Tabl(1 To 3, 1 To 1) Tabl(1, 1) = CInt((675 * Rnd()) + 1) ' => Propriété Left Tabl(2, 1) = CInt((675 * Rnd()) + 1) ' => Propriété Top Tabl(3, 1) = CInt((5 * Rnd()) + 1) ' => Valeur End Sub Sub Sens_Aleatoire() 'calcul aléatoire de Coeff_Sens_Left et Coeff_Sens_Top pour la première direction Dim Valeurs(200), i As Long 'Les 2 coeffs sont des valeurs comprises entre -1 et +1 Step 0.01 : -1, -0.99, -0.98, ... For i = -100 To 100 Valeurs(i + 100) = i / 100 Next i 'calcul aléatoire de Coeff_Sens_Left et Coeff_Sens_Top Coeff_Sens_Left = Valeurs(CInt((199 * Rnd()) + 1)) Coeff_Sens_Top = Valeurs(CInt((199 * Rnd()) + 1)) End Sub Merci de m'avoir lu jusqu'ici et pour vos éventuels éclaircissements. Cordialement, Franck

jordane45 · Answer

Bonjour, Essaye ça : 'Permet de changer de sens lorsque le dé touche un des bords de la piste If De_Left < 0 Then Coeff_Sens_Left = Coeff_Sens_Left * -1 De_Left = 0 End If 'Pas de valeur numérique => permet de changer la taille de l'UserForm If De_Left >= Piste.Width - (Piste.ImageDe.Width + 2) Then Coeff_Sens_Left = Coeff_Sens_Left * -1 De_Left = Piste.Width - (Piste.ImageDe.Width + 2) '///////////////////////SOUCI "Léger" Debug.Print ("Piste.Width" & Piste.Width & " Piste.ImageDe.Width:" & Piste.ImageDe.Width) Debug.Print ("De_Left : " & De_Left) End If If De_Top < 0 Then Coeff_Sens_Top = Coeff_Sens_Top * -1 De_Top = 0 End If If De_Top >= Piste.Height - 2 * Piste.ImageDe.Height + 2 Then Coeff_Sens_Top = Coeff_Sens_Top * -1 De_Top = Piste.Height - 2 * Piste.ImageDe.Height + 2 '///////////////////////SOUCI "Important" End If

pijaku · Answer

Salut Jordane45,

Merci de ta réponse, effectivement je n'avais pas vérifié ces valeurs.
Mais bon...
J'ai testé sur les valeurs Top car c'est plus flagrant.
En "Debug" comme ceci :
De_Top = Piste.Height - Piste.ImageDe.Height 
Debug.Print ("Piste.Height : " & Piste.Height & " - Piste.ImageDe.Height : " & Piste.ImageDe.Height)
Debug.Print ("De_Top : " & De_Top)
J'obtiens :
Piste.Height : 700 - Piste.ImageDe.Height : 24De_Top : 676 
Ce qui, logiquement est correct. Mon dé ne devrait passer dépasser le cadre de l'UserForm.
Or, visuellement, il y va carrément.
D'où mon interrogation.
Ne serait ce pas du à la hauteur de la barre de fenêtre de l'UserForm qui devrait être prise en compte? 
Autre piste : une quelconque "marge" due à un "je ne sais quoi" dans ma configuration?

ucfoutu · Answer

Bonjour, Pijaku,
ton "doevents" est ici maladroit :
Do While StopIt = False    Force = Force + (1 * i)    If Force = 1 Then i = 1    If Force = 100 Then i = -1    DoEvents 'permet de déclencher l'événement Mouse_Up et donc de Stopper cette boucleLoop
car il est de nature à torturer indûment ton processeur.
Préfère-lui la mise en place d'un timer
Au minimum : laisse un peu respirer (une attente de 0,05 secondes, par exemple) entre l'affichage de deux images successives.

pijaku · Answer

Bon et bien après quelques tests (je ne cries pas victoire trop vite), que je vais continuer à pousser, il s'avère qu'il existe une alternative à Sleep.
C'est bien cette fonction qui faisait planter le bouzin... 
Par conséquent, il suffit de la remplacer par une fonction "maison" qui utilise le Timer, en lui faisant réaliser une action inutile.
Du genre :

Sub Attendre(Duree As Single)
Dim t As Single, i As Byte, k As Byte, Tb(1)
t = Timer
k = 1
Do
'je l'ai bien dit que c'est n'importe quoi...
If i Mod 2 = 0 Then Tb(k) = i
Loop While CDbl(Format(Timer - t, "#0.00000")) < Duree
Debug.Print Format(Timer - t, "#0.00000")
End Sub

Le code d'appel est, tout simplement :
Attendre 0.05 'attente de 5 centièmes de secondes

C'est précis à un centième de seconde et demi (0.015 seconde) près... Ce qui est déjà très bien pour Excel et VBA.

ucfoutu · Answer

J'éviterais personnellement les doevents inutiles (n'appelant le doevents que lorsque nécessaire).
L'installation d'un timer (avec addressof) aurait ma préférence.
Mais tu peux éviter l'utilisation de l'API de Windows et te contenter de Application.Ontime, tout en ayant une fréquence meilleure que de 1 seconde, en t' amusant. Ainsi, par exemple :
sur un userform : un bouton de commande CommandButton1 et un Label Label1 et ce code :
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) actif = True Application.OnTime Now, "titi" ' on "lance" sans attendreEnd SubPrivate Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  actif = FalseEnd Sub
et dans un Module :
Private der As Double, cpt As LongPublic actif As BooleanPublic Sub titi()  If Timer > der + 0.05 Or der = 0 Then    cpt = cpt + 1 '                   | ou toutes autres    UserForm1.Label1.Caption = cpt '  | actions de ton choix    DoEvents ' un doevents qui n'interviendra que si condition remplie             ' (si + de 0,05 sec écoulées    der = Timer  End If  If actif Then    Application.OnTime Now, "titi" ' on "relance" aussitôt"  Else    cpt = 0    der = 0  End IfEnd Sub
La variable cpt n'est là que pour simuler et visualiser une "action"
La variable der n'est là que pour pallier l'inconvénient qui pourrait résulter d'un passage à Minuit.

J'ai allégé ce matin (fatigué et bâclé hier)
 
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

ucfoutu · Answer

Bon ...
je vais maintenant aborder un autre aspect important :
celui d'un Doevents qui ne concernerait pas la totalité des messages du système, mais uniquement ceux destinés à l'application.
Le distinguo est très important : en "contrôlant", on ne "rend la main" au système que lorsque l'appli en cours est elle-même concernée par un message (quel qu'il puisse être). Ce sera bien évidemment le cas du MouseUp de ton bouton ...
De cette manière : aucune "dépense" due au Doevents si l'appli n'est pas concernée elle-même. Lde gain de temps est considérable.
Je vais (cet aprem) te concocter une petite démo et te la faire parvenir par MP.
Elle risquera (suis encore fatigué) d'être assez "bâclée", mais elle sera sans aucun doute très "parlante".
Je compterai sur toi pour en faire (et le déposer) un source commenté (agrémenté à ta sauce) car je ne me sens pas encore en parfait état pour faire ce dépôt.
A cet aprem

ucfoutu · Answer

Bon.... Nous allons maintenant considérer deux choses distinctes, Pijaku : 1) l'utilité de faire un petit tuto/démo sur la base de ce que tu sais maintenant (mes MP)... et je te laisserai faire (tu l'as promis). 2) une approche de ton problème de dés. Je te laisse, pour ce second point UNIQUEMENT regarder ce que ferait ceci, qui s'appuie sur différents aspects, dont celui que je t'ai exposé par MP. Il devrait t' "inspirer" assez, ... je pense ... Sur nun userform : - 1 bouton de commande Commandbutton1 - 1 textbox textbox1 placée en dessous et ce code : Private Declare Function GetInputState Lib "user32" () As LongPrivate toto As BooleanPrivate Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sens As Integer, pas As Double, cpt As Integer toto = False Me.Caption = "pression en cours" sens = -1 pas = 15 Do deb = Timer Do While Timer - deb < 0.02 Loop If TextBox1.Left <= pas Or TextBox1.Left + TextBox1.Width + pas >= Me.Width Then sens = -sens End If pas = pas * 0.992 ' on ralentit peu à peu le déplacement TextBox1.Move TextBox1.Left + (sens * pas) If pas < 0.2 Then toto = False: Exit Do ' si presque immobile, on l'arrête If GetInputState And Not toto Then DoEvents cpt = cpt + 1 End If Me.Repaint Loop Until toto = True Me.Caption = "le doevents n'a été utilise que " & cpt & " fois" toto = FalseEnd SubPrivate Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) toto = True ' pour interrompre la boucleEnd Sub Que fait-il ? 1) Il lance en boucle le déplacement de la textbox au keydown 2) le déplacement de la textbox est ralenti au fur et à mesure du déplacement 3) la boucle est interrompue au MouseUp, à tout instant 4) si l'on ne fait pas de MouseUp, la boucle est également interrompue au bout d'un certain temps (et ralentissement) Observe le caption du UserForm : si interruption volontaire : un seul Doevents. Si interruption au bout d'un certain temps : même pas besoin d'un Doevents. Ce code est tout simplement une "conjugaison" de tout ce que tu sais maintenant. Amitiés EDIT : amuse-toi ensuite à faire varier le pas et le coef de ralentissement par ex : pas = 50 et coef = 0.94 au lieu de 0.992 "joue" également avec la limite d'arrêt (If pas < 1 Then toto = False: Exit Do) (arrange à ton goût ...très flexible). ________________________ Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches. Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

ucfoutu · Answer

Après réflexion et essais, il est plus réaliste et plus exact d'écrire ainsi le MouseDown :
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  Dim sens As Integer, pas As Double, cpt As Integer, cogne As Boolean  toto = False  Me.Caption = "pression en cours"  sens = -1  pas = 60  Do    deb = Timer    Do While Timer - deb < 0.04    Loop    pos = TextBox1.Left + (sens * pas)        Select Case pos       Case Is <= 0: pos = 0: cogne = True       Case Is >= Me.Width - TextBox1.Width: pos = Me.Width - TextBox1.Width: cogne = True                    End Select    If cogne Then ' si l'on a cogné un bord      sens = -sens ' on inverse alors le sens      pas = pas * 0.6 ' ralentissement additionnel du fait du choc      cogne = False    End If    TextBox1.Left = pos    pas = pas * 0.98  ' on ralentit peu à peu le déplacement, de manière générale    If pas < 2 Then toto = False: Exit Do   ' si presque immobile, on l'arrête    If GetInputState And Not toto Then      DoEvents      cpt = cpt + 1    End If    Me.Repaint  Loop Until toto = True  Me.Caption = "le doevents n'a été utilise que " & cpt & " fois"  toto = False  toto = FalseEnd Sub
Laz textbox atteint ainsi parfaitement les deux côtés, d'une part.
Et, d'autre part, chaque choc sur un côté provoque (logique) un ralentissement complémentaire.

pijaku · Answer

Bonjour,

Ne connaissant pas, avant ce week end, la fonction GetInputState, il faut que j'étudie cela au calme.
J'ai déjà saisi son utilité, il ne reste qu'à adapter ton code (ce n'est pas compliqué, mais je préfères poser cela tranquillement).
Quand au "format" de ce que l'on peut en tirer, ce sera, très certainement un tuto accompagné d'une source, pourquoi pas.

Je me penche dessus... juste après mon café!

pijaku · Answer

C'est parfait!

La démarche que je suis pour lancer un dé :
Dans la "vie réelle", lorsqu'on lance un dé, on gère la force et la direction, et après, le dé se "débrouille" seul.
Dans mon UserForm, la force est déterminée par l'appui (+ ou - long) sur un bouton de commande (Mouse_Down), la direction est déterminée lors de l'événement Mouse_Up, le déplacement du dé par une procédure simple.
En voici l'exemple ou n'est pas encore traité le déplacement vertical, exemple basé sur ton code ucfoutu, scindé en deux parties : calcul de la force et déplacement du dé.
Toujours un UserForm avec un CommandButton et un TextBox (qui, à terme, sera remplacé par une contrôle Image) :

Option Explicit

Private Declare Function GetInputState Lib "user32" () As Long

Private toto As Boolean, pas As Double

Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  Dim sens As Integer, cpt As Integer
  
  toto = False
  sens = 1
  TextBox1.Visible = False
  CommandButton1.Caption = "Relachez pour lancer le dé"
  Me.Repaint
  pas = 1
  
  Do
    If pas = 70 Or pas = 0 Then sens = sens * -1
    pas = pas + (1 * sens)
    
    If GetInputState And Not toto Then
      DoEvents
      cpt = cpt + 1
    End If
  Loop Until toto = True
End Sub
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  toto = True ' pour interrompre la boucle
  'Direction
  TextBox1.Visible = True
  Lancer
End Sub

Private Sub UserForm_Initialize()
  TextBox1.Visible = False
  CommandButton1.Caption = "Maintenez pour calculer la force du lancer"
  Me.Caption = ""
End Sub

Sub Direction()
End Sub

Sub Lancer()
 Dim sens As Integer, cogne As Boolean, deb As Double, pos As Double

sens = -1
  Me.Caption = "Dé lancé"
  Do
    deb = Timer
    Do While Timer - deb < 0.04
    Loop
    pos = TextBox1.Left + (sens * pas)
    
    Select Case pos
       Case Is <= 0: pos = 0: cogne = True
       Case Is >= Me.Width - TextBox1.Width: pos = Me.Width - TextBox1.Width: cogne = True
    End Select
    
    If cogne Then ' si l'on a cogné un bord
      sens = -sens ' on inverse alors le sens
      pas = pas * 0.6 ' ralentissement additionnel du fait du choc
      cogne = False
    End If
    
    TextBox1.Left = pos
    pas = pas * 0.98  ' on ralentit peu à peu le déplacement, de manière générale
    If pas < 2 Then Exit Do   ' si presque immobile, on l'arrête
    Me.Repaint
  Loop
  With Me
    .CommandButton1.Visible = True
    .CommandButton1.Caption = "Maintenez pour calculer la force du lancer"
    .Caption = "Relancez le dé..."
  End With
End Sub

ucfoutu · Answer

Bon,
Je vais alors faire un petit exemple avec déplacements dans tous les sens ... (un exemple de base, qu
A très bientôt (il ne devrait pas me falloir plus de six minutes).

ucfoutu · Answer

Bon, 1) pour éviter des calculs additionnels dus à la barre de titre de l'userform, nous allons utiliser un Frame (rien ne t'empêche, si tu le veux, de lui donner carrément les dimensions de ton userform. Et nous allons déplacer la textbox dans les deux sens à l'intérieur de ce Frame (Frame1) 2) sur un userform : - 1 Frame Frame1 rectangulaire de 150 x 186, sans caption et avec une bordure (option 1). Rectangulaire et non carré si l'on veut n'avoir qu'un pas. Si carré, va falloir deux pas différents (un vertical et l'autre horizontal, sinon on ne parcourra bien évidement qu'une diagonale ) - dans ce frame (en mode création) : une textbox de 25 x 25 - un bouton de commande commandbutton1 (en dehors du Frame) avec ce code modifié (tout le reste restant identique) : Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)Dim sensh As Integer, pas As Double, cpt As Integer, cogneh As Boolean, cognev As Boolean toto = False Me.Caption = "pression en cours" sensh = -1 sensv = -1 pas = 200 Do deb = Timer Do While Timer - deb < 0.02 Loop posh = TextBox1.Left + (sensh * pas) posv = TextBox1.Top + (sensv * pas) Select Case posh Case Is <= 0: posh = 0: cogneh = True Case Is >= Frame1.Width - TextBox1.Width: posh = Frame1.Width - TextBox1.Width: cogneh = True End Select Select Case posv Case Is <= 0: posv = 0: cognev = True Case Is >= Frame1.Height - TextBox1.Height: posv = Frame1.Height - TextBox1.Height: cognev = True End Select If cogneh Then ' si l'on a cogné un bord sensh = -sensh ' on inverse alors le sens pas = pas * 0.8 ' ralentissement additionnel du fait du choc cogneh = False End If If cognev Then ' si l'on a cogné un bord sensv = -sensv ' on inverse alors le sens pas = pas * 0.8 ' ralentissement additionnel du fait du choc cognev = False End If TextBox1.Move posh, posv pas = pas * 0.98 ' on ralentit peu à peu le déplacement, de manière générale If pas < 2 Then toto = False: Exit Do ' si presque immobile, on l'arrête If GetInputState And Not toto Then DoEvents cpt = cpt + 1 End If Me.Repaint Loop Until toto = True Me.Caption = "le doevents n'a été utilise que " & cpt & " fois" toto = FalseEnd Sub Les reactions sont les mêmes que précédemment en ce qui concerne une pression continue ou une pression interrompue. Seule différence : parcours dans les deux sens Tu peux t'amuser à décider aléatoirement, à chaque lancer : - de la position de départ, - du sens - de la valeur du pas, etc ... ________________________ Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches. Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

ucfoutu · Answer

Tu peux toujours te déplacer sur des vecteurs (d'équation y = ax + b), mais cela va te compliquer les choses et non les faciliter.
Si tu y tiens toutefois, tu trouveras comment procéder en examinant l'un des sources que j'ai déposé il n'y a que quelques mois à ce sujet.
A tout hasard (si tu ne l'a pas trouvé) ===>>

 http://codes-sources.commentcamarche.net/source/53889-vb6-deplacement-d-un-controle-sur-un-segment-de-droite-delimite-par-deux-points-de-coordonnees-connues
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

pijaku · Answer

Bonjour,

J'ai évoqué, ci-dessus, la possibilité de lancer plusieurs dés.
J'ai réussi à faire quelque chose, mais cela ne me convient pas entièrement.

Pour associer l'utile à l'agréable, j'ai réalisé cela avec un module de classe, étant novice en cette matière cela me semblait judicieux.
Tout fonctionne bien mais, comme dit plus haut, je ne suis pas satisfait.
Ma question est la suivante : comment ajouter une propriété à un objet de manière permanente, sans qu'il retourne systématiquement dans le module de classe pour recalculer...

Exemple de ce que j'ai fait :
Dans un module standard :
Public mesImages() As New Classe1

Dans le module de l'UserForm, à l'initialize :

For Each Ctrl In Me.Controls
    If Ctrl.Name Like "Image*" Then
        Nb_Des = Nb_Des + 1
        ReDim Preserve mesImages(1 To Nb_Des)
        Ctrl.Visible = False
        Set mesImages(Nb_Des).Imgs = Ctrl
    End If
  Next Ctrl

Dans le module de classe :
Public WithEvents Imgs As MSForms.Image

Property Get coef_X() As Double
Dim Valeurs(), i As Long
  ReDim Preserve Valeurs(200)
  For i = -100 To 100
    Valeurs(i + 100) = i / 100
  Next i
  'calcul aléatoire de Coeff_X
  coef_X = Valeurs(CInt((199 * Rnd()) + 1))
End Property

Property Get coef_Y() As Double
Dim Valeurs(), i As Long
  ReDim Preserve Valeurs(200)
  For i = -100 To 100
    Valeurs(i + 100) = i / 100
  Next i
  'calcul aléatoire de Coeff_X
  coef_Y = Valeurs(CInt((199 * Rnd()) + 1))
End Property

Je pensais, naïvement, que, à l'initialisation de mon UserForm, il allait me calculer, pour chaque image, ses propres propriétés Coef_X et coef_Y et qu'après, dans le code, je pourrais les retrouver en faisant : mesImages(indice).coef_X.
Malheureusement, cette façon de faire recalcule systématiquement mes coef_X et coef_Y. Or, comme vous l'avez constaté, ceux-ci sont aléatoires, mais ne doivent l'être qu'une fois, à l'initialisation...

J'ai contourné cela en stockant ces valeurs dans des variables tableaux, mais, du coup, je ne vois plus l'intérêt d'un module de classe...

Ma question : n'y a t'il pas un moyen de calculer une fois pour toutes les valeurs des propriétés que je créée?

pijaku · Answer

Bonjour, Désolé pour la stupidité de ma question à propos des propriétés dans le module de classe. Je ne devais vraiment pas être réveillé... Bon, voici l'état d'avancement de mon projet. J'ai modifié le code initial pour : - ajouter un "effet" léger sur le mouvement afin "d'arrondir" les déplacements. - faire en sorte de pouvoir lancer plusieurs dés. Pour cela, il nous faut : - 1 userform dans lequel vous dessinez : 1 Frame (Frame1), un Bouton de commande (CommandButton1) et autant d'image que de dés souhaités (Image1, Image2, Image3... Si vous changez le nom des Images, conservez le préfixe : "Image") - 1 module "standard" (Module1) - 1 module de classe (Classe1). Les codes : Dans le module de l'UserForm : Option Explicit Private Declare Function GetInputState Lib "user32" () As Long Private Arret As Boolean, Nb_Des As Integer Private Sub UserForm_Initialize() Dim Ctrl As Control With Me .Caption = "" .Width = 400 .Height = 400 End With With Frame1 .Caption = "" .BorderStyle = fmBorderStyleSingle .Move 0, 0, Me.Width - 4, Me.Height - 21 End With For Each Ctrl In Me.Controls If Ctrl.Name Like "Image*" Then Nb_Des = Nb_Des + 1 ReDim Preserve mesImages(1 To Nb_Des) Ctrl.Visible = False Set mesImages(Nb_Des).ImagesEvents = Ctrl End If Next Ctrl CommandButton1.Caption = "Maintenez pour calculer la force du lancer" Randomize Timer End Sub Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sens As Integer, Cpt As Integer Arret = False sens = 1 For Cpt = 1 To Nb_Des With Me.Controls("Image" & Cpt) .Move CInt(((Me.Width - 1) * Rnd()) + 1), CInt(((Me.Width - 1) * Rnd()) + 1), 25, 25 .Visible = False End With Next Cpt CommandButton1.Caption = "Relachez pour lancer le dé" Me.Repaint pasGeneral = 1 Do If pasGeneral = 200 Or pasGeneral = 0 Then sens = sens * -1 pasGeneral = pasGeneral + (1 * sens) If GetInputState And Not Arret Then DoEvents End If Loop Until Arret = True End Sub Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim Cpt As Integer Arret = True ' pour interrompre la boucle For Cpt = 1 To Nb_Des Calcul_Coeff Cpt Me.Controls("Image" & Cpt).Visible = True Next Lancer End Sub Sub Lancer() Dim sens As Integer, cogneH As Boolean, cogneV As Boolean, deb As Double, posH As Double, posV As Double, Quoi As String, Cpt As Integer Dim NumAutresDes() As Integer, i As Integer, k As Integer, Sortie As Integer ReDim Preserve NumAutresDes(Nb_Des - 2) With Me .CommandButton1.Visible = False .Caption = "Dé lancé..." Do For Cpt = 1 To Nb_Des 'temps de pause deb = Timer Do While Timer - deb < 0.04 Loop If Abs(mesImages(Cpt).coef_X) > Abs(mesImages(Cpt).coef_Y) Then mesImages(Cpt).effetVertical = False Else mesImages(Cpt).effetVertical = True If mesImages(Cpt).effetVertical = True Then mesImages(Cpt).coef_X = mesImages(Cpt).coef_X + mesImages(Cpt).effet Else mesImages(Cpt).coef_Y = mesImages(Cpt).coef_Y + mesImages(Cpt).effet End If 'calcul de la position du dé posH = Left, posV = Top posH = .Controls("Image" & Cpt).Left + mesImages(Cpt).pas * mesImages(Cpt).coef_X posV = .Controls("Image" & Cpt).Top + mesImages(Cpt).pas * mesImages(Cpt).coef_Y 'Stocke le numéro des autres dés pour voir s'ils ne s'entrechoquent pas) k = 0 For i = 1 To Nb_Des If i <> Cpt Then NumAutresDes(k) = i k = k + 1 End If Next 'En fonction de la position, regarde si le dé touche les bords ou un autre dé If Cogne(posH, posV, Quoi) = True Then 'Si le dé rencontre un obstacle => change le sens ChangeDirection Cpt, Quoi End If If Entrechoque(posH, posV, NumAutresDes, Quoi) = True Then 'GoTo Fin ChangeDirection Cpt, Quoi End If If mesImages(Cpt).pas > 2 Then .Controls("Image" & Cpt).Move posH, posV mesImages(Cpt).pas = mesImages(Cpt).pas * 0.98 ' on ralentit peu à peu le déplacement, de manière générale .Repaint End If Next Cpt 'Si le pas de toutes les images est < 2 => sortie de boucle Sortie = 0 For Cpt = 1 To Nb_Des If mesImages(Cpt).pas < 2 Then Sortie = Sortie + 1 Next Cpt If Sortie = Nb_Des Then Exit Do Loop .CommandButton1.Visible = True .CommandButton1.Caption = "Maintenez pour calculer la force du lancer" .Caption = "Relancez le dé..." End With End Sub Function Cogne(posH As Double, posV As Double, Quoi As String) As Boolean Dim Cpt As Integer Cogne = False For Cpt = 1 To Nb_Des Select Case posH Case Is <= 0: posH = 0: Cogne = True: Quoi = "Obstacle vertical" Case Is >= Me.Frame1.Width - Me.Controls("Image" & Nb_Des).Width: posH = Me.Frame1.Width - Me.Controls("Image" & Nb_Des).Width: Cogne = True: Quoi = "Obstacle vertical" End Select Select Case posV Case Is <= 0: posV = 0: Cogne = True: Quoi = "Obstacle horizontal" Case Is >= Me.Frame1.Height - Me.Controls("Image" & Nb_Des).Height: posV = Me.Frame1.Height - Me.Controls("Image" & Nb_Des).Height: Cogne = True: Quoi = "Obstacle horizontal" End Select Next End Function Function Entrechoque(posH As Double, posV As Double, NumAutresDes() As Integer, Quoi As String) As Boolean 'A REALISER : lorsque deux dés se touchent... End Function Sub ChangeDirection(Num As Integer, Quoi As String) Select Case Quoi Case "Obstacle vertical" mesImages(Num).coef_X = -mesImages(Num).coef_X ' on inverse alors le sens Case "Obstacle horizontal" mesImages(Num).coef_Y = -mesImages(Num).coef_Y ' on inverse alors le sens End Select mesImages(Num).pas = mesImages(Num).pas * 0.6 ' ralentissement additionnel du fait du choc mesImages(Num).effetVertical = Not mesImages(Num).effetVertical mesImages(Num).effet = -mesImages(Num).effet End Sub Dans le module "standard : Public mesImages() As New Classe1 Public pasGeneral As Double Public Sub Calcul_Coeff(NumImage As Integer) Dim Valeurs(), i As Long ReDim Preserve Valeurs(200) For i = -100 To 100 Valeurs(i + 100) = i / 100 Next i 'calcul aléatoire de Coeff_X mesImages(NumImage).coef_X = Valeurs(CInt((199 * Rnd()) + 1)) mesImages(NumImage).coef_Y = Valeurs(CInt((199 * Rnd()) + 1)) If Abs(mesImages(NumImage).coef_X) > Abs(mesImages(NumImage).coef_Y) Then mesImages(NumImage).effet = mesImages(NumImage).coef_X / 30 mesImages(NumImage).effetVertical = False Else mesImages(NumImage).effet = mesImages(NumImage).coef_Y / 30 mesImages(NumImage).effetVertical = True End If mesImages(NumImage).pas = pasGeneral + CInt((19 * Rnd()) + 1) End Sub Dans le Module de classe : Option Explicit Public WithEvents ImagesEvents As MSForms.Image Public coef_X As Double Public coef_Y As Double Public effet As Double Public effetVertical As Boolean Public pas As Double Il me reste donc à faire : - La fonction Entrechoque (deux dés qui se heurtent), - Changer les propriétés Picture des contrôles Images afin d'afficher de vrais dés...

pijaku · Answer

Bonjour, Petit retour en arrière pour "mettre au propre" le projet. Il y a maintenant la possibilité de placer plusieurs "joueurs". Le code est mieux "ordonné", plus rangé, les variables plus explicites etc... Mais... Je rencontre bug sur bug pendant les tests et je n'arrive pas à déterminer de ou cela peut provenir... Pas de message d'erreur, si ce n'est : Ne réponds pas... et je suis obligé de couper Excel "sauvagement". Si l'un d'entre vous peut y jeter un oeil... Alors, le fichier doit être composé de : - 1 UserForm (name : Piste) sur lequel vous dessinez : 1 Frame (name : Frame1) et des CommandButton (j'ai testé jusque 4) et des Images (Name Image*) (j'ai testé jusque 5) Le nombre de boutons détermine le nombre de joueurs, le nombre d'images détermine le nombre de dés... - 1 Module - 2 Modules de classe : Classe_Boutons et Classe_Dé Les codes : UserForm : Option Explicit Private Sub UserForm_Initialize() Dim ctrControl As Control Dim intIndic As Integer 'Initialisation des variables publiques Set objBtn = Nothing dblPasGeneral = 1 intNb_Des = 0 intNb_Joueurs = 0 Erase bytVal_Prec 'MISE EN FORME (esthétique) 'UserForm With Piste .Caption = "" .Width = 400 .Height = 400 End With 'Frame1 With Frame1 .Caption = "" .BorderStyle = fmBorderStyleSingle .BackColor = 32768 .Move 0, 0, Piste.Width - 4, Piste.Height - 21 End With 'Boucle sur les contrôles pour en faire des instances de nos classes For Each ctrControl In Piste.Controls 'Evite un bug dans la Sub Lancer avec CInt(Ctrl.Tag) ctrControl.Tag = 0 'Si le contrôle a pour propriété Name : Image* '(préfixe Image, valable pour Image1, Image2, Image_Dé_1 etc, non valide pour Imag1 par exemple) If ctrControl.Name Like "Image*" Then 'MISE EN FORME (esthétique) With ctrControl .Width = 40 .Height = 40 .Visible = False .PictureSizeMode = fmPictureSizeModeStretch End With 'on comptabilise le nombre de dés intNb_Des = intNb_Des + 1 ReDim Preserve Dé(1 To intNb_Des) 'On créé notre "Objet" Dé dans la Classe_Dé 'cf déclaration de variable dans le Module : Public Dé() As New Classe_Dé 'cf : Module de Classe Classe_Dé Set Dé(intNb_Des).ImagesEvents = ctrControl 'Dimensionnement de la variable tableau bytVal_Prec 'cette variable va stocker la valeur précédente de chacun des dés 'pour pouvoir la passer en paramètre de la propriété Valeur des dés (cf Module Classe_Dé) ReDim Preserve bytVal_Prec(intNb_Des - 1) 'Attribution des valeurs initiales à chacune des propriétés du dé Paramétrage_Dés ctrControl, intNb_Des Placement_Dés ctrControl, intNb_Des ElseIf ctrControl.Name Like "CommandButton*" Then 'Si le contrôle a pour propriété Name CommandButton* 'on comptabilise le nombre de joueurs intNb_Joueurs = intNb_Joueurs + 1 ReDim Preserve Boutons(1 To intNb_Joueurs) Set Boutons(intNb_Joueurs).BoutonsEvents = ctrControl ctrControl.Tag = intNb_Joueurs ctrControl.Caption = "Joueur " & intNb_Joueurs ctrControl.Move 0, 0, 60, 24 'on ne laisse affiché que le bouton Joueur 1 If intNb_Joueurs > 1 Then ctrControl.Visible = False End If Next ctrControl 'initialisation du générateur de nombre aléatoire Randomize Timer 'Joueur "en cours" = Joueur 1 intJoueurEncours = 1 End Sub Module : Option Explicit Public Dé() As New Classe_Dé Public Boutons() As New Classe_Boutons Public objBtn As Object Public bytVal_Prec() As Byte Public dblPasGeneral As Double Public intNb_Des As Integer, intNb_Joueurs As Integer, intJoueurEncours As Integer Sub Paramétrage_Dés(Ctrl As Control, Num As Integer) Dim Tb(200) As Double, i As Integer Dé(Num).Nom = Ctrl.Name Dé(Num).Cote = Ctrl.Width 'Les propriétés coef_X et coef_Y sont des valeurs 'comprises entre -1 et 1 Step 0.01 For i = -100 To 100 Tb(i + 100) = i / 100 Next i 'Calcul aléatoire des coef X et Y Dé(Num).coef_X = Tb(CInt((199 * Rnd()) + 1)) Dé(Num).coef_Y = Tb(CInt((199 * Rnd()) + 1)) 'le pas de chaque dé peut être différent à peu de variante tout de même Dé(Num).pas = dblPasGeneral + CInt((19 * Rnd()) + 1) 'calcul de la valeur initiale du dé 'La valeur précédente du dé doit être passée en paramètre, '(à part pour la valeur initiale...) 'Donc nous la stockons dans une variable tableau bytVal_Prec(Num - 1) = Dé(Num).Valeur(0) End Sub Sub Placement_Dés(Ctrl As Control, Num As Integer) 'sans importance pour le moment Ctrl.Move 40 * Num, 40 * Num End Sub Sub Lancer() Dim deb As Double, posH As Double, posV As Double Dim Cpt As Integer, Sortie As Integer, intScore As Integer Dim Quoi As String, strMsg As String Dim Tab_Dés_Choc() As Integer Dim Ctrl As Control With Piste Do For Cpt = 1 To intNb_Des 'temps de pause deb = Timer Do While Timer - deb < 0.04 Loop 'calcul de la position du dé posH = Left, posV = Top posH = Dé(Cpt).Gauche + Dé(Cpt).pas posV = Dé(Cpt).Haut + Dé(Cpt).pas 'En fonction de la position, regarde si le dé touche les bords ou un autre dé If Cogne(posH, posV, Quoi, Cpt) = True Then 'Si le dé rencontre un obstacle => change le sens ChangeDirection Cpt, Quoi End If If Dé(Cpt).pas > 2 Then .Controls(Dé(Cpt).Nom).Move posH, posV bytVal_Prec(Cpt - 1) = Dé(Cpt).Valeur(bytVal_Prec(Cpt - 1)) .Controls(Dé(Cpt).Nom).Picture = LoadPicture(ThisWorkbook.Path & "\" & bytVal_Prec(Cpt - 1) & ".gif") Dé(Cpt).pas = Dé(Cpt).pas * 0.5 ' on ralentit peu à peu le déplacement, de manière générale .Repaint End If Next Cpt 'Si le pas de tous les dés est < 2 => sortie de boucle Sortie = 0 For Cpt = 1 To intNb_Des If Dé(Cpt).pas < 2 Then Sortie = Sortie + 1 Next Cpt If Sortie = intNb_Des Then Exit Do Loop 'Affiche le score dans le Caption de l'UserForm For Cpt = LBound(bytVal_Prec) To UBound(bytVal_Prec) strMsg = strMsg & bytVal_Prec(Cpt) & " + " intScore = intScore + bytVal_Prec(Cpt) Next Cpt strMsg = Left(strMsg, Len(strMsg) - 2) & "= " & intScore .Caption = .Caption & " Score : " & strMsg End With 'Affiche le bouton du joueur suivant intJoueurEncours = intJoueurEncours + 1 If intJoueurEncours = 5 Then intJoueurEncours = 1 For Each Ctrl In Piste.Controls If CInt(Ctrl.Tag) = intJoueurEncours Then Ctrl.Visible = True: Exit For Next End Sub Function Cogne(posH As Double, posV As Double, Quoi As String, Lequel As Integer) As Boolean Dim Cpt As Integer Cogne = False Select Case posH Case Is <= 0: posH = 0: Cogne = True: Quoi = "Obstacle vertical" Case Is >= Piste.Frame1.Width - Dé(Lequel).Cote: posH = Piste.Frame1.Width - Dé(Lequel).Cote: Cogne = True: Quoi = "Obstacle vertical" End Select Select Case posV Case Is <= 0: posV = 0: Cogne = True: Quoi = "Obstacle horizontal" Case Is >= Piste.Frame1.Height - Dé(Lequel).Cote: posV = Piste.Frame1.Height - Dé(Lequel).Cote: Cogne = True: Quoi = "Obstacle horizontal" End Select End Function Sub ChangeDirection(Num As Integer, Quoi As String) Select Case Quoi Case "Obstacle vertical" Dé(Num).coef_X = -Dé(Num).coef_X ' on inverse alors le sens Case "Obstacle horizontal" Dé(Num).coef_Y = -Dé(Num).coef_Y ' on inverse alors le sens End Select Dé(Num).pas = Dé(Num).pas * 0.6 ' ralentissement additionnel du fait du choc End Sub Module de Classe Classe_Boutons : Option Explicit Private Declare Function GetInputState Lib "user32" () As Long Public WithEvents BoutonsEvents As MSForms.CommandButton Dim blnArret As Boolean Public Sub BoutonsEvents_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sens As Integer, Cpt As Integer 'Initialisation des variables 'blnArret => permet de quitter la boucle Do Loop ci dessous ' en relachant le clic de souris (événement MouseUp) 'sens => le "pas" de chaque dé est une valeur comprise entre 0 et 150 ' sens permet de varier de 0 à 150 puis de 150 à 0 blnArret = False sens = 1 'Placement initial de chacun des dés For Cpt = 1 To intNb_Des With Piste.Controls(Dé(Cpt).Nom) .Move CInt(((Piste.Width - 1) * Rnd()) + 1), CInt(((Piste.Width - 1) * Rnd()) + 1), 25, 25 .Visible = False End With Next Cpt Piste.Caption = BoutonsEvents.Caption Piste.Repaint 'calcul du pas général, tant que le joueur appuie sur le bouton dblPasGeneral = 50 Do blnArret = True If dblPasGeneral = 150 Or dblPasGeneral = 49 Then sens = sens * -1 '"oscille entre 50 et 150 dblPasGeneral = dblPasGeneral + (1 * sens) If GetInputState And Not blnArret Then DoEvents End If Loop Until blnArret = True End Sub Public Sub BoutonsEvents_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim Cpt As Integer blnArret = True ' pour interrompre la boucle For Cpt = 1 To intNb_Des Piste.Controls(Dé(Cpt).Nom).Visible = True Piste.Controls(Dé(Cpt).Nom).Picture = LoadPicture(ThisWorkbook.Path & "\" & bytVal_Prec(Cpt - 1) & ".gif") Next BoutonsEvents.Visible = False Call Lancer 'paramètres des dés du joueur suivant For Cpt = 1 To intNb_Des Paramétrage_Dés Piste.Controls(Dé(Cpt).Nom), Cpt Next Cpt End Sub Module de classe Classe_Dé Option Explicit Public WithEvents ImagesEvents As MSForms.Image Public Nom As String Public Cote As Double Public coef_X As Double Public coef_Y As Double Public pas As Double Property Get Gauche() As Double Gauche = ImagesEvents.Left End Property Property Get Haut() As Double Haut = ImagesEvents.Top End Property Property Get Droite() As Double Droite = Gauche + Cote End Property Property Get Bas() As Double Bas = Haut + Cote End Property Property Get Valeur(ValeurPrec As Byte) As Byte If ValeurPrec = 0 Then Valeur = CInt((5 * Rnd()) + 1) Else Do Valeur = CInt((5 * Rnd()) + 1) Loop While Valeur = ValeurPrec And Valeur = 7 - ValeurPrec End If End Property EDIT : Il vous faudra également les images des dés : http://cjoint.com/?DJbpsV7P0q7 🎼 Cordialement, Franck 🎶

ucfoutu · Answer

Bonjour,
déjà : pas adroit d'utiliser select case pour changer de sens, puisque select case quittera au premier cas rencontré.
Quid alors si cogne à la fois verticalement et horizontalement ? Ton select case ne changera qu'un seul des deux sens.
Utilise plutôt deux conditions If ( sans elseif)

ucfoutu · Answer

Venons-en maintenant, Franck, à ton histoire de plantage dénoncée plus haut et pour laquelle tu cherchjes une explication.
Regarde ce que tu fais :
Tu calcules si débordement et inverses alors le sens.
Que se passe-t-il alors, surtout lorsque le "pas" est devenu petit :
- tu as déjà "débordé". Imaginons que tu aies beaucoup débordé. Tu reviens en arrière, mais tu as déjà réduit le pas, ce qui fait que tu peux dans certains cas (surtout si tu as considérablement réduit le pas) rester en débordement ===>> et ton code, tel qu'écrit, va provoquer un nouveau changement de sens (et cette fois-ci : dans le mauvais sens).
- ce n'est pas ce qu'il convient de fair(e.
Il faut aller dans cet ordre :
1) calculer la position qui résulterait de l'avancement (sans encore modifier la position)
2) si cette position "théorique" conduit à un"débord" :
 a) la corriger d'abord
 b) appliquer la position (non corrigée si non débord ou corrigée si débord)
c) changer le sens et décider du ralentissement éventuel

C'est le mécanisme que j'ai appliqué (voir plus haut) dans mon message du  21 sept. 2014 à 18:11 

NB : tu as moins de problèmes avec 0.98 qu'avec 0.5 pour cette raison même. Puisqu'en divisant le pas par deux, tu as beaucoup plus de chances, après débord, de rester en débord !
Mais même avec 0.98, tu risques de te retrouver dans un cas de figure identique à un moment ou l'autre, si "pas de bol" !
Applique ce que je t'ai dit (mon code du  21 sept. 2014 à 18:11 ) et tu seras à l'abri de cet aléa.

pijaku · Answer

Bonjour tout le monde, Voici l'avancement du code. J'essaie de commenter un maximum, mais je dois être encore un peu confus dans mes explications... J'ai écarté l'idée d'avancer avec un seul pas au profit d'un avancement en fonction de 2 paramètres coef_X et coef_Y (abscisse et ordonnée) auxquels vient s'ajouter la force du jet (calculée au maintien du clic sur le bouton). J'ai également considéré l'emplacement du joueur et calculé coef_X et coef_Y en fonction de deux points : l'endroit du "tir" et l'endroit de chute du dé. Vous verrez, j'ai fait un dessin ;-) - 1 Userform (Name : Piste), 1 Frame (Frame1), autant de CommandButton que de joueurs, autant d'Image (Name : Image*) que de dés souhaités. Son code : Option Explicit Private Sub UserForm_Initialize() Dim ctrControl As Control Dim intIndic As Integer 'Initialisation des variables publiques Set objBtn = Nothing intForce = 1 intNb_Des = 0 intNb_Joueurs = 0 Erase bytVal_Prec Erase G Erase T 'MISE EN FORME (esthétique) 'UserForm With Piste .Caption = "" .Width = 400 .Height = 400 End With 'Frame1 With Frame1 .Caption = "" .BorderStyle = fmBorderStyleSingle .BackColor = 32768 .Move 0, 0, Piste.Width - 4, Piste.Height - 21 End With 'Boucle sur les contrôles pour en faire des instances de nos classes For Each ctrControl In Piste.Controls 'Evite un bug dans la Sub Lancer avec CInt(Ctrl.Tag) ctrControl.Tag = 0 'Si le contrôle a pour propriété Name : Image* '(préfixe Image, valable pour Image1, Image2, Image_Dé_1 etc, non valide pour Imag1 par exemple) If ctrControl.Name Like "Image*" Then 'MISE EN FORME (esthétique) With ctrControl .Width = 32 .Height = 32 .Visible = False .PictureSizeMode = fmPictureSizeModeStretch End With 'on comptabilise le nombre de dés intNb_Des = intNb_Des + 1 ReDim Preserve Dé(1 To intNb_Des) 'On créé notre "Objet" Dé dans la Classe_Dé 'cf déclaration de variable dans le Module : Public Dé() As New Classe_Dé 'cf : Module de Classe Classe_Dé Set Dé(intNb_Des).ImagesEvents = ctrControl 'Dimensionnement de la variable tableau bytVal_Prec 'cette variable va stocker la valeur précédente de chacun des dés 'pour pouvoir la passer en paramètre de la propriété Valeur des dés (cf Module Classe_Dé) ReDim Preserve bytVal_Prec(intNb_Des - 1) 'Attribution des valeurs initiales à certaines des propriétés du dé Dé(intNb_Des).Nom = ctrControl.Name Dé(intNb_Des).Cote = ctrControl.Width ElseIf ctrControl.Name Like "CommandButton*" Then 'Si le contrôle a pour propriété Name CommandButton* 'on comptabilise le nombre de joueurs intNb_Joueurs = intNb_Joueurs + 1 ReDim Preserve Boutons(1 To intNb_Joueurs) Set Boutons(intNb_Joueurs).BoutonsEvents = ctrControl ctrControl.Tag = intNb_Joueurs ctrControl.Caption = "Joueur " & intNb_Joueurs ctrControl.Move 0, 0, 60, 24 'on ne laisse affiché que le bouton Joueur 1 If intNb_Joueurs > 1 Then ctrControl.Visible = False End If Next ctrControl 'initialisation du générateur de nombre aléatoire Randomize Timer 'Joueur "en cours" = Joueur 1 intJoueurEncours = 1 End Sub - 1 Module : Le code (je vous ai laissé les dessins...) : Option Explicit Public Dé() As New Classe_Dé Public Boutons() As New Classe_Boutons Public objBtn As Object Public bytVal_Prec() As Byte, G() As Integer, T() As Integer Public Tir_X As Double, Tir_Y As Double Public intForce As Integer, intNb_Des As Integer, intNb_Joueurs As Integer, intJoueurEncours As Integer, LancerDe As Integer Sub Paramétrage_Dés(Ctrl As Control, Num As Integer) Dim i As Integer, BienPlace As Boolean Dé(Num).Nom = Ctrl.Name Dé(Num).Cote = Ctrl.Width 'calcul de la valeur initiale du dé 'La valeur précédente du dé doit être passée en paramètre, '(à part pour la valeur initiale...) 'Donc nous la stockons dans une variable tableau bytVal_Prec(Num - 1) = Dé(Num).Valeur(0) 'le premier endroit ou apparaissent les dés est fonction de 'l'endroit duquel le joueur jette les dés. Il est choisit aléatoirement 'parmi 8 possibilités : ' 1 2 3 ' --------------- ' | | ' | | ' 8 | piste | 4 ' | | ' | | ' --------------- ' 7 6 5 'Le 1er dé (Num = 1) est celui qui détermine l'aire de retombée des autres, puisque, 'dans un même lancer, les dés ne "tombent" pas aux 4 coins de la piste. On considère 'que l'aire de retombée occupe une surface valant 1/4 de la piste totale ' aire pour 1 : aire pour 2 : aire pour 3 : etc... ' --------------- --------------- --------------- ' | | | | | | | | | | ' | 1 | | | | 2 | | | | 3 | ' |-------| | | |------| | | |-------| ' | | | | | | ' | | | | | | ' --------------- --------------- --------------- 'La direction que va suivre le dé dépend : 'de l'endroit de tir 'de l'endroit de chute 'Avec ces deux points connus, nous pouvons déterminer les propriétés coef (X et Y) de nos dés 'Nous venons de voir le point de chute, il nous manque de point de tir. 'Exemple pour la position 1 : 'On va choisir un endroit aléatoire sur la ligne qui part du 1 : ' 1---------2 3 ' --------------- ' | | ' | | ' 8 | piste | 4 ' | | ' | | ' --------------- ' 7 6 5 'exemple pour le 2 : exemple pour le 3 : exemple pour le 4 : etc... ' 1 2---------3 1 2 3 1 2 3 ' --------------- --------------- | --------------- ' | | | | | | | ' | | | | | | | ' 8 | piste | 4 8 | piste | 4 8 | piste | 4 ' | | | | | | | ' | | | | | | | ' --------------- --------------- --------------- | ' 7 6 5 7 6 5 7 6 5 'Si c'est le 1er dé , on détermine de ou lance le joueur If Num = 1 Then LancerDe = CInt((7 * Rnd()) + 1) 'Détermination du point exact d'ou est lancé le dé Select Case LancerDe Case 1: Tir_X = CInt(Piste.Frame1.Width / 2 * Rnd()): Tir_Y = -(Piste.Frame1.Height / 4) '0 < Tir X < 200 ; Y fixe Case 2: Tir_X = CInt(Piste.Frame1.Width / 2 * Rnd() + Piste.Frame1.Width / 2): Tir_Y = -(Piste.Frame1.Height / 4) '200 < Tir X < 400 ; Y fixe Case 3: Tir_X = Piste.Frame1.Width + Piste.Frame1.Width / 4: Tir_Y = CInt(Piste.Frame1.Height / 2 * Rnd()) 'Tir X fixe ; 0 < Tir Y < 200 Case 4: Tir_X = Piste.Frame1.Width + Piste.Frame1.Width / 4: Tir_Y = CInt(Piste.Frame1.Height / 2 * Rnd() + Piste.Frame1.Height / 2) 'X fixe ; 200 < Tir Y < 400 Case 5: Tir_X = CInt(Piste.Frame1.Width / 2 * Rnd() + Piste.Frame1.Width / 2): Tir_Y = Piste.Frame1.Height + Piste.Frame1.Height / 4 '200 < X < 400 ; Y Fixe Case 6: Tir_X = CInt(Piste.Frame1.Width / 2 * Rnd()): Tir_Y = Piste.Frame1.Height + Piste.Frame1.Height / 4 '0 < X < 200 ; Y Fixe Case 7: Tir_X = -(Piste.Frame1.Width / 4): Tir_Y = CInt(Piste.Frame1.Height / 2 * Rnd() + Piste.Frame1.Height / 2) 'X fixe ; 200 < Tir Y < 400 Case 8: Tir_X = -(Piste.Frame1.Width / 4): Tir_Y = CInt(Piste.Frame1.Height / 2 * Rnd()) 'Tir X fixe ; 0 < Tir Y < 200 End Select End If 'Pour éviter la superposition de deux dés, il nous faut regarder les propriétés Left '(G()) et Top (T())(déclarées en public) de tous les dés déjà lancés... ou pas! ReDim Preserve G(Num) ReDim Preserve T(Num) Do BienPlace = True Select Case LancerDe Case 1: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd()): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd()) 'propriétés Left et top entre 0 et 200 Case 2: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd + Piste.Frame1.Width / 4): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd()) ' 100 < Left < 300 et 0 < top < 200 Case 3: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd + Piste.Frame1.Width / 2 - Dé(Num).Cote): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd()) ' 160 < Left < 360 et 0 < top < 200 Case 4: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd + Piste.Frame1.Width / 2 - Dé(Num).Cote): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd + Piste.Frame1.Height / 4) ' 160 < Left < 360 et 100 < top < 300 Case 5: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd + Piste.Frame1.Width / 2 - Dé(Num).Cote): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd + Piste.Frame1.Height / 2 - Dé(Num).Cote) ' 160 < Top et Left < 360 Case 6: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd + Piste.Frame1.Width / 4): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd + Piste.Frame1.Height / 2 - Dé(Num).Cote) ' 100 < Left < 300 et 160 < top < 360 Case 7: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd()): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd + Piste.Frame1.Height / 2 - Dé(Num).Cote) '0 < Left < 200 et 160 < top < 360 Case 8: G(Num) = CInt(Piste.Frame1.Width / 2 * Rnd()): T(Num) = CInt(Piste.Frame1.Height / 2 * Rnd + Piste.Frame1.Height / 4) ' 0 < Left < 200 et 100 < top < 300 End Select 'A partir du second dé, il faut éviter le chevauchement : If Num > 1 Then For i = 1 To Num - 1 'on boucle sur les dés déjà tirés 'on compare leurs côtés gauches respectifs If G(Num) >= G(i) And G(Num) <= G(i) + Dé(Num).Cote Or G(Num) < G(i) And G(Num) + Dé(Num).Cote > G(i) Then 'Et on compare leur Top... If T(Num) >= T(i) And T(Num) <= T(i) + Dé(Num).Cote Or T(Num) < T(i) And T(Num) + Dé(Num).Cote > T(i) Then BienPlace = False: Exit For End If Next i End If 'On boucle tant que le dé est mal placé! Loop While BienPlace = False 'On place le dé Ctrl.Move G(Num), T(Num) 'Ctrl.Visible = False 'calcul des coef_X et coef_Y Dé(Num).coef_X = G(Num) - Tir_X Dé(Num).coef_Y = T(Num) - Tir_Y End Sub Sub Lancer() Dim deb As Double, posH As Double, posV As Double Dim Cpt As Integer, Sortie As Integer, intScore As Integer Dim QuoiH As String, QuoiV As String, strMsg As String Dim Tab_Dés_Choc() As Integer Dim Ctrl As Control With Piste Do Sortie = 0 For Cpt = 1 To intNb_Des '********************************** petit temps de pause deb = Timer Do While Timer - deb < 0.04 Loop '********************************* positionnement 'calcul de la position du dé posH = Left, posV = Top posH = Dé(Cpt).Gauche + Dé(Cpt).coef_X posV = Dé(Cpt).Haut + Dé(Cpt).coef_Y '********************************* Cogne contre un bord de la piste 'En fonction de la position, regarde si le dé touche les bords de la piste QuoiV = "" QuoiH = "" If Cogne(posH, posV, QuoiH, QuoiV, Cpt) = True Then 'Si le dé rencontre un obstacle => change le sens ChangeDirection Cpt, QuoiH, QuoiV End If '********************************* Entrechoc de deux dés '********************************* Déplacement du dé 'pas calculé en faisant la racine carrée de la somme des carrés des 2 côtés d'un triangle... If Sqr(Dé(Cpt).coef_X ^ 2 + Dé(Cpt).coef_Y ^ 2) > 2 Then .Controls(Dé(Cpt).Nom).Move posH, posV 'déplacement bytVal_Prec(Cpt - 1) = Dé(Cpt).Valeur(bytVal_Prec(Cpt - 1)) 'calcul valeur 'affichage de l'image en fonction de la valeur .Controls(Dé(Cpt).Nom).Picture = LoadPicture(ThisWorkbook.Path & "\" & bytVal_Prec(Cpt - 1) & ".gif") ' on ralentit peu à peu le déplacement, de manière générale Dé(Cpt).coef_X = Dé(Cpt).coef_X * 0.8 Dé(Cpt).coef_Y = Dé(Cpt).coef_Y * 0.8 .Repaint Else Sortie = Sortie + 1 End If Next Cpt 'Si le "pas" de tous les dés est < 2 => sortie de boucle If Sortie = intNb_Des Then Exit Do Loop 'Affiche le score dans le Caption de l'UserForm For Cpt = LBound(bytVal_Prec) To UBound(bytVal_Prec) strMsg = strMsg & bytVal_Prec(Cpt) & " + " intScore = intScore + bytVal_Prec(Cpt) Next Cpt strMsg = Left(strMsg, Len(strMsg) - 2) & "= " & intScore .Caption = .Caption & " Score : " & strMsg End With 'Affiche le bouton du joueur suivant intJoueurEncours = intJoueurEncours + 1 If intJoueurEncours > intNb_Joueurs Then intJoueurEncours = 1 For Each Ctrl In Piste.Controls If CInt(Ctrl.Tag) = intJoueurEncours Then Ctrl.Visible = True: Exit For Next End Sub Function Cogne(posH As Double, posV As Double, QuoiH As String, QuoiV As String, Lequel As Integer) As Boolean 'En fonction de la position, regarde si le dé touche les bords de la piste Dim Cpt As Integer Cogne = False Select Case posH Case Is <= 0: posH = 0: Cogne = True: QuoiH = "Obstacle vertical" Case Is >= Piste.Frame1.Width - Dé(Lequel).Cote: posH = Piste.Frame1.Width - Dé(Lequel).Cote: Cogne = True: QuoiH = "Obstacle vertical" End Select Select Case posV Case Is <= 0: posV = 0: Cogne = True: QuoiV = "Obstacle horizontal" Case Is >= Piste.Frame1.Height - Dé(Lequel).Cote: posV = Piste.Frame1.Height - Dé(Lequel).Cote: Cogne = True: QuoiV = "Obstacle horizontal" End Select End Function Sub ChangeDirection(Num As Integer, QuoiH As String, QuoiV As String) 'Si le dé rencontre un obstacle => change le sens If QuoiH = "Obstacle vertical" Then Dé(Num).coef_X = -Dé(Num).coef_X ' on inverse alors le sens horizontalement If QuoiV = "Obstacle horizontal" Then Dé(Num).coef_Y = -Dé(Num).coef_Y ' on inverse alors le sens verticalement Dé(Num).coef_X = Dé(Num).coef_X * 0.6 ' ralentissement additionnel du fait du choc Dé(Num).coef_Y = Dé(Num).coef_Y * 0.6 End Sub - 2 Modules de classe : Classe_Boutons : Private Declare Function GetInputState Lib "user32" () As Long Public WithEvents BoutonsEvents As MSForms.CommandButton Dim blnArret As Boolean Public Sub BoutonsEvents_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim sens As Integer, Cpt As Integer 'Initialisation des variables 'blnArret => permet de quitter la boucle Do Loop ci dessous ' en relachant le clic de souris (événement MouseUp) 'sens => la force du lancer est une valeur comprise entre 0 et 50 ' sens permet de varier de 0 à 50 puis de 50 à 0 blnArret = False sens = 1 'paramètres des dés du joueur suivant For Cpt = 1 To intNb_Des Paramétrage_Dés Piste.Controls(Dé(Cpt).Nom), Cpt Piste.Controls(Dé(Cpt).Nom).Visible = False Next Cpt Piste.Caption = BoutonsEvents.Caption Piste.Repaint 'calcul de la force du lancer, tant que le joueur appuie sur le bouton intForce = 1 Do blnArret = True If intForce = 50 Or intForce = 0 Then sens = sens * -1 '"oscille" entre 0 et 50 intForce = intForce + (1 * sens) 'Permet de ne déclencher le DoEvents que si l'utilisateur fait une action 'en l'occurence lacher le bouton de la souris If GetInputState And Not blnArret Then DoEvents 'permet de laisser faire l'événement MouseUp End If Loop Until blnArret = True End Sub Public Sub BoutonsEvents_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim Cpt As Integer blnArret = True ' pour interrompre la boucle For Cpt = 1 To intNb_Des 'On applique la force aux deux coefficients de déplacement des dés : If Dé(Cpt).coef_X < 0 Then Dé(Cpt).coef_X = Dé(Cpt).coef_X - intForce Else Dé(Cpt).coef_X = Dé(Cpt).coef_X + intForce If Dé(Cpt).coef_Y < 0 Then Dé(Cpt).coef_Y = Dé(Cpt).coef_Y - intForce Else Dé(Cpt).coef_Y = Dé(Cpt).coef_Y + intForce 'On affiche nos dés Piste.Controls(Dé(Cpt).Nom).Visible = True 'On charge l'image correspondant à leur valeur Piste.Controls(Dé(Cpt).Nom).Picture = LoadPicture(ThisWorkbook.Path & "\" & bytVal_Prec(Cpt - 1) & ".gif") Next 'On masque le bouton de commande du joueur en cous BoutonsEvents.Visible = False 'et on lance les dés (cf Module...) Call Lancer End Sub Classe_Dé : Option Explicit 'propriétés des images de dés Public WithEvents ImagesEvents As MSForms.Image Public Nom As String 'Name Public Cote As Double 'Width (=Height) Public coef_X As Double 'déplacement horizontal du dé Public coef_Y As Double 'déplacement vertical du dé Property Get Gauche() As Double 'Left Gauche = ImagesEvents.Left End Property Property Get Haut() As Double 'Top Haut = ImagesEvents.Top End Property Property Get Droite() As Double 'Right Droite = Gauche + Cote End Property Property Get Bas() As Double 'Bottom Bas = Haut + Cote End Property Property Get Valeur(ValeurPrec As Byte) As Byte 'Value If ValeurPrec = 0 Then Valeur = CInt((5 * Rnd()) + 1) Else Do Valeur = CInt((5 * Rnd()) + 1) Loop While Valeur = ValeurPrec And Valeur = 7 - ValeurPrec End If End Property

pijaku · Answer

Re-Bonjour,

Besoin d'un appui, non pas technique, mais de bon sens...

Êtes vous d'accord avec cette analyse du choc entre x dés : 

S'il y a choc, il faut distinguer plusieurs cas :    Cas 1 : Les dés vont dans la même direction ou presque        => le dé heurté accélère légèrement mais continue dans la même direction        => le dé qui heurte ralentit et change légèrement de direction, mais toujours dans le même sens    Cas 2 : les dés vont dans des directions opposées        => les deux dés ralentissent et changent de sens
 
Seconde question : cette analyse, si elle est juste pour 2 dés, l'est-elle également pour 3, 4 ou plus de dés???

Merci par avance

Mouvement d'un dé dans un UserForm

23 réponses

Votre réponse

Discussions similaires