Posez votre question Signaler

Drag and Drop en VB net entre PictureBox [Résolu]

Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 - - Dernière réponse : vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 - 29 mai 2015 à 21:18
VB.NET Posez votre question Signaler
Bonjour à tous!
Je travaille sous VB Net ( version 2013 Express) et je suis l'auteur du jeu de lettres en VB net déposé sur le site ( le Scabble pour ne pas le citer)

Le code fonctionne correctement partout !
Voulant le customiser au niveau ergonomie et étant donné que les lettres se déplacent par Drag and Drop entre le plateau de jeu et le sabot du joueur j'ai voulu ajouter ce bout de code trouvé sur le Net 

Private Sub CasejeuGiveFeedback(ByVal sender As Object, _
    ByVal e As GiveFeedbackEventArgs) Handles pb1.GiveFeedback
        e.UseDefaultCursors = False
        Dim myPic As New Bitmap(CType(sender, PictureBox).Image)
        cursorImage = myPic.GetThumbnailImage(25, 25, Nothing, IntPtr.Zero)
        Cursor.Current = New Cursor(CType(cursorImage, System.Drawing.Bitmap).GetHicon())
    End Sub


Ce bout de code permet lors du Drag and Drop de faire suivre l'image pendant le déplacement . Je lance mon projet et je joue tout à fait normalement ! Au bout d'un moment ( une quarantaine de lettres jouées environ) le jeu se bloque sans aucun message d'erreur quel qu'il soit !
C'est arrivé quelque fois qu'un message me signifiait que je n'avais pas assez de mémoire ! Bizarre avec un Pc normal sous Windows 8.1 avec 4 Go de RAM !

Serai-ce le fait de créer un New Bitmap et un New Cursor et que ceux-ci ne seraient pas "détruits" à la fin du Drag and Drop ?

Je rappelle que sans cette amélioration visuelle le projet n'a aucun problème et je peux jouer pluseurs parties entières !

Merci d'avance à toute personne qui pourrait me donner une piste de solution !

Bonsoir ou bonjour à tous et en attente de vous lire

VB95
Afficher la suite 

Votre réponse

Répondre au sujet

10 réponses

Meilleure réponse
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
1
Merci
Tu devrais cependant revoir ta méthode, car elle me parait bien lourde
ton :
Ce bout de code permet lors du Drag and Drop de faire suivre l'image pendant le déplacement

n'est pas exact. Tu ne fais pas "suivre l'image", mais donne au curseur l'apparence de l'image que tu déplaces.
Je comprends que le drag and drop ne te satisfait pas vraiment. Mais rien ne t'empêche alors de lui substituer un glisser/déplacer de l'image que tu déplaces (par utilisation de l'évènement MouseMove ). Cela doit pouvoir se faire sous VB.Net aussi facilement que cela se fait sous VB6.

EDIT : je ne connais par ailleurs pas VB.Net et ignore la portée réelle d'un changement du curseur par le code que tu nous montres. Es-tu bien certain que ce curseur (le dernier ainsi défini) ne restera pas celui du système en cas de plantage inopiné de ton appli intervenant par malheur pendant ton drag and drop (donc avant de rétablir le curseur par défaut) ?

________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.

Dire « Merci » 1

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

Codes Sources 119 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
1
Merci
Voici comment faire avec un glisser au MouseMove :
1) mettre le contrôle à déplacer en 1er plan et relever sa position de départ (les coordonnées de l'emplacement où il était)
2) le faire glisser au MouseMove
3) au MouseUp :
- si (calcul arithmétique) les nouvelles coordonnées sont "à l'extérieur" du container d'arrivée ===>> on remet ce contrôle là où il était auparavant
- si "à l'intérieur" du container d'arrivée ===>>
---- on rend ce container d'arrivée parent du contrôle déplacé
---- on calcule les nouvelles coordonnées relatives du contrôle, par rapport à son nouveau container (calcul arithmétique simple)
Tout cela parait compliqué, mais ne l'est pas du tout.
Si tu veux : je peux te faire un petit exemple simple, mais en VB6.

Dire « Merci » 1

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

Codes Sources 119 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
1
Merci
Tiens ==>> voilà un petit exemple bâclé (je dois partir à la pêche) sous VB6 :
- sur un Form : une picturebox et une textbox ===>> 
Private ancX As Integer, ancY As Integer, origx As Integer, origy As Integer
    Private harponne As Boolean

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Text1.Left = X
  Text1.Top = Y
End Sub

Private Sub Text1_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ancX = X
    ancY = Y
    harponne = True
    If Not Text1.Container Is Picture1 Then
      origx = Text1.Left
      origy = Text1.Top
    End If
End Sub


Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If harponne Then
    Text1.Left = Text1.Left + (X - ancX)
    Text1.Top = Text1.Top + (Y - ancY)
   End If
End Sub


Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If harponne And Not Text1.Container Is Picture1 Then
    If Text1.Left >= Picture1.Left And Text1.Top >= Picture1.Top And _
    Text1.Left <= Picture1.Width + Picture1.Left And Text1.Top <= Picture1.Top + Picture1.Height Then
      Text1.Left = 0
      Text1.Top = 0
      Set Text1.Container = Picture1
      MsgBox "voilà ton contrôle sur le plateau" & vbCrLf & "place-l'y maintenant où tu veux"
    Else
      Text1.Left = origx
      Text1.Top = origy
    End If
  End If
  harponne = False
End Sub



Ah oui ... je viens de rajouter le retour à sa place si pas sur le plateau.
Allez ===>> J'espère que le poisson coopèrera aujourd'hui.
EDIT : Et il e'st bien clair que si tu veux placer la textbox là où tu es au mouseup : 
Text1.Left = Text1.Left - Picture1.Left
      Text1.Top = Text1.Top - Picture1.Top

au lieu des = 0 qui la placent en haut à gauche, bien sûr.

Et il va sans dire (mais tu l'auras deviné seul) qu'il t'est également possible d'annuler tes gestes.
Exemple sur le double click en ajoutant simplement : 
Private Sub Text1_DblClick()
  If Text1.Container Is Picture1 Then
    If MsgBox("voules-vous annuler ce placement ?", vbYesNo) = vbYes Then
      Set Text1.Container = Me
      Text1.Left = origx
      Text1.Top = origy
    End If
  End If
End Sub


________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.

Dire « Merci » 1

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

Codes Sources 119 internautes nous ont dit merci ce mois-ci

Commenter la réponse de ucfoutu
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
1
Merci
Tu as tort de me trouver "chef" trop tôt.
Je t'ai dit ce matin que je bâclais pour aller à la pêche (au passage : un fiasco)
Voilà du "plus mieux", maintenant : 
 Private ancX As Integer, ancY As Integer, origx As Integer, origy As Integer
Private harponne As Boolean

Private Sub Text1_DblClick()
  If Text1.Container Is Picture1 Then
    If MsgBox("voules-vous annuler ce placement", vbYesNo) = vbYes Then
      remettre Text1
    End If
  End If
End Sub

Private Sub Text1_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ancX = X
    ancY = Y
    If Not Text1.Container Is Picture1 Then
      origx = Text1.Left
      origy = Text1.Top
    End If
    harponne = True
End Sub


Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If harponne Then
    Text1.Left = Text1.Left + (X - ancX)
    Text1.Top = Text1.Top + (Y - ancY)
    If Not Text1.Container Is Picture1 Then
      If harponne And Not Text1.Container Is Picture1 Then
        If Text1.Left >= Picture1.Left And Text1.Top >= Picture1.Top And _
          Text1.Left <= Picture1.Width + Picture1.Left And Text1.Top <= Picture1.Top + Picture1.Height Then
          Text1.Left = Text1.Left - Picture1.Left
          Text1.Top = Text1.Top - Picture1.Top
          Set Text1.Container = Picture1
        End If
      End If
    Else
      Select Case Text1.Left
       Case Is < 0
        Text1.Left = 1
       Case Is > Picture1.Width - Text1.Width
        Text1.Left = Picture1.Width - Text1.Width - 1
      End Select
      Select Case Text1.Top
       Case Is < 0
        Text1.Top = 1
       Case Is > Picture1.Height - Text1.Height
        Text1.Top = Picture1.Height - Text1.Height - 1
      End Select
    End If
    
   End If
End Sub


Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Not Text1.Container Is Picture1 Then
     remettre Text1
   End If
   harponne = False
End Sub

Private Sub remettre(ctrl As TextBox)
  Set Text1.Container = Me
  Text1.Left = origx
  Text1.Top = origy
End Sub



La "chrono" du code est maintenant différente
Quelles sont les modifications/améliorations ?
- on n'attend plus le mouseup pour "passer" dans la picturebox. On y passe "dans la foulée"
- une fois que l'on est dans la picturebox, on ne peut plus en "déborder".

C'est écrit pour VB6. Tu peux donc tester avec VB6. Tu peux également tester avec EXCEL/VBA, mais en utilisant alors un Frame (pas de picturebox en VBA).
Amitiés.
Je retourne à la pêche (je suis un têtu invétéré).



Dire « Merci » 1

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

Codes Sources 119 internautes nous ont dit merci ce mois-ci

Signaler Commenter la réponse de vb95
vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 60 -
Merci ucfoutu !
Tu m'as donné l'idée du code base et je l'ai amélioré et peaufiné pour l'intégrer dans le projet de Scrabble !
Moi non plus je n'attends pas la Mouseup
Voici chronologiquement ce que je fais
- MouseDown sur la case source du sabot
- Un Click sur une case "clone" : la case source n'est plus celle du sabot mais une picturebox qui est son clone à la même position mais en premier plan
- MouseMove du clone jusquà la destination
- et un MouseUp du clone pour valider la destination

C'est au MouseUp du clone que je fais des calculs pour connaitre laquelle des 224 cases du plateau je veux atteindre ( en me servant de la position du curseur et de la zone qu'occupe le plateau à l'écran

Et cela fonctionne nickel
un grand merci à toi pour ton idée !
Commenter la réponse de ucfoutu
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
0
Merci
Bonjour,
Serai-ce le fait de créer un New Bitmap et un New Cursor et que ceux-ci ne seraient pas "détruits" à la fin du Drag and Drop ?

Oui.
Commenter la réponse de ucfoutu
Signaler Commenter la réponse de ucfoutu
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
 264
0
Merci
https://msdn.microsoft.com/en-us/library/office/ee557362%28v=office.14%29.aspx

exemple ===>> myPic.Dispose
Commenter la réponse de ucfoutu
Signaler Commenter la réponse de vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 60
0
Merci
Merci ucfoutu
Je m'en vais de ce pas tester

bien le bonjour à toi
Commenter la réponse de vb95
Signaler Commenter la réponse de vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 60
0
Merci
Bonjour ucfoutu
C'est exact : l'image reste en place et c'est le curseur qui prend l'apparence de l'image ! Dans mon projet de Scrabble on déplace la lettre du sabot vers le plateau de jeu par Drag and Drop ! L'image d'origine ne doit pas bouger car à la fin du Drag and Drop elle représentera une place du sabot vide
Ce que tu dis à propos de plantage sysème lors du Drag and Drop est tout à fait justifié à mes yeux !
Merci de tes réflextions et salut à toi
Commenter la réponse de vb95
Signaler Commenter la réponse de vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 60
0
Merci
Pour ucfoutu

Je suis contraint à utiliser le DRag and Drop car avec Mousemove lorsque j'arrive sur la case de destination sur le plateau de Scrabble l'évènement Mousemove ne me permet pas de déposer la case du sabot sur celle du plateau de jeu . Je ne peux même pas cliquer la case de destination sur le jeu vu que l'image de la case du sabot la recouvre !
A + et merci de ton temps
Commenter la réponse de vb95
Signaler Commenter la réponse de vb95
Messages postés
1797
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
17 février 2019
 60
0
Merci
un grand merci Ucfoutu
Voici mon code en VB net

Plus besoin du tout du DragandDrop et le déplacement est fluide
Bravo à toi : tu es un chef
La pèche a été bonne j'espère ? 

 Private Sub CasesabotMousedown(sender As Object, e As MouseEventArgs)

        sourceindex = Convert.ToInt32(DirectCast(sender, PictureBox).Name.Substring(9))
        source = DirectCast(sender, PictureBox).Name.Substring(0, 9)
        ancX = e.X
        ancY = e.Y
        harponne = True
        origx = pictsabot(sourceindex).Left
        origy = pictsabot(sourceindex).Top
        pictsabot(sourceindex).BringToFront()

    End Sub

    Private Sub CasesabotMouseMove(sender As Object, e As MouseEventArgs)

        If harponne = True Then
            pictsabot(sourceindex).Left = pictsabot(sourceindex).Left + (e.X - ancX)
            pictsabot(sourceindex).Top = pictsabot(sourceindex).Top + (e.Y - ancY)
        End If

    End Sub

    Private Sub CasesabotMouseUp(sender As Object, e As MouseEventArgs)

        Dim colonnedrag As Integer, lignedrag As Integer
        Dim positionmouse As Point

        If harponne = True Then
            positionmouse = Me.PointToClient(Cursor.Position) ' position du curseur sur la Form
' chaque case fait 34 de haut et de large
' on enlève la position de la case en haut à gauche et on divise par 34 pour avoir la colonne ou la ligne de la case
            colonnedrag = (positionmouse.X - 205) \ 34
            lignedrag = (positionmouse.Y - 60) \ 34
            If colonnedrag >= 0 AndAlso lignedrag >= 0 Then
                pictsabot(sourceindex).Left = origx
                pictsabot(sourceindex).Top = origy
                ' Getindex me donne l'indice de la case en fonction de la ligne et de la colonne
                destinationindex = Getindex(lignedrag, colonnedrag)
                CasejeuDrop()
            End If
        End If
        harponne = False

    End Sub
Commenter la réponse de vb95

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.