Drag & Drop, comment faire?

Résolu
Signaler
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
-
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
-
Salut, j'aimerais savoir comment qu'on fait pour faire un drag & drop d'une image(1) vers une autre image(2). J'aimerais aussi savoir, si possible, comment qu'on fait pour continuer de voir l'image que l'on déplace. Merci

13 réponses

Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
Option Explicit


Dim Bool As Boolean
Dim XX As Integer
Dim YY As Integer
Dim tx As Integer
Dim ty As Integer


Private Sub Form_Load()
' tolérance réglée au quart de l'image
tx = Image1(0).Width / 4
ty = Image1(0).Height / 4
End Sub


Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = True XX X: YY Y
End Sub


Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx As Integer
Dim dy As Integer
Dim i As Integer
Dim j As Integer
If Bool = True Then
i = Index
dx = ScaleX(X - XX, vbTwips, ScaleMode)
dy = ScaleY(Y - YY, vbTwips, ScaleMode)
Image1(i).Move Image1(i).Left + dx, Image1(i).Top + dy
For j = 0 To Image1.Count - 1
dx = ScaleX(Abs(Image1(j).Left - Image1(i).Left), ScaleMode, vbPixels)
dy = ScaleY(Abs(Image1(j).Top - Image1(i).Top), ScaleMode, vbPixels)
If j <> i And Image1(j).Visible = True Then
If dx < tx And dy < ty Then
Image1(j).Picture = Image1(i).Picture
Image1(i).Visible = False
Beep
End If
End If
Next
End If
End Sub


Private Sub Image1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = False
End Sub


Daniel
3
Merci

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

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

Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

Merci. J'ai du apporter quelque correction sinon l'image allait directement dans l'autre malgré le fait du table. voici les correction(en fait, c'est seulement une ligne qui causait problème.)
Dim Bool As Boolean
Dim table() As Boolean


Dim XX As Integer
Dim YY As Integer
Dim tx As Integer
Dim ty As Integer


Private Sub Form_Load()
ReDim table(Image1.UBound) As Boolean


' tolérance réglée au quart de l'image
tx = Image1(0).Width / 4
ty = Image1(0).Height / 4
End Sub


Private Sub Image1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = True XX X: YY Y
table(Index) = True
End Sub


Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim dx As Integer
Dim dy As Integer
Dim i As Integer
Dim j As Integer


If Bool = True Then
If Not table(Index) Then Exit Sub
i = Index
dx = ScaleX(X - XX, vbTwips, ScaleMode)
dy = ScaleY(Y - YY, vbTwips, ScaleMode)
Image1(i).Move Image1(i).Left + dx, Image1(i).Top + dy
For j = 0 To Image1.Count - 1
dx = ScaleX(Abs(Image1(j).Left - Image1(i).Left), ScaleMode, vbPixels)
dy = ScaleY(Abs(Image1(j).Top - Image1(i).Top), ScaleMode, vbPixels)
If j <> i And Image1(j).Picture <> Image1(i).Picture Then
'Pour tester si l'image est moindrement dans l'autre
If (Image1(i).Left + Image1(i).Width > Image1(j).Left And Image1(i).Left + Image1(i).Width < Image1(j).Left + Image1(j).Width And Image1(i).Top > Image1(j).Top And Image1(i).Top < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left > Image1(j).Left And Image1(i).Left < Image1(j).Left + Image1(j).Width And Image1(i).Top > Image1(j).Top And Image1(i).Top < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left + Image1(i).Width > Image1(j).Left And Image1(i).Left + Image1(i).Width < Image1(j).Left + Image1(j).Width And Image1(i).Top + Image1(i).Height > Image1(j).Top And Image1(i).Top + Image1(i).Height < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left > Image1(j).Left And Image1(i).Left < Image1(j).Left + Image1(j).Width And Image1(i).Top + Image1(i).Height > Image1(j).Top And Image1(i).Top + Image1(i).Height < Image1(j).Top + Image1(j).Height) Then
Image1(j).Picture = Image1(i).Picture
Image1(i).Picture = Nothing
End If
End If
Next j
End If


End Sub


Private Sub Image1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = False
table(Index) = False
End Sub
3
Merci

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

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

Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
utilise des PictureBox

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function ReleaseCapture Lib "User32" () As Long

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Call ReleaseCapture
SendMessage Picture1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub

Daniel
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

Merci, mais le problème est que je dois pouvoir voir le background et les picturebox me le cache. c'est pour cela que j'ai besoin des Image... a moins que quelqu'un ne sache comment faire pour voir l'arrière plan d'un Picturebox.
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

Petit oubli, le problème reste aussi que l'image bouger doit prendre la place d'une autre image.
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
beaucoup moins joli avec des Images.

Option Explicit


Dim Bool As Boolean
Dim XX As Integer
Dim YY As Integer


Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = True XX X: YY Y
End Sub


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Bool = True Then
Image1.Move Image1.Left + X - XX, Image1.Top + Y - YY
End If

End Sub


Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Bool = False
End Sub

Daniel
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

Merci, mais comment je fait si je veux que, si l'image1 est par dessus l'image2, celle-ci prend l'image de l'image1 et l'image1 devient vide (si ca peut t'aider à m'aider, c'est pour mon jeu d'échec que j'en ai besoin donc si quelque chose n'est pas clair, tu peux penser à un jeu d'échec pour savoir ce que je veux dire et comment je vais utiliser le drag&drop.)
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

J'ai essayer, mais il y a un petit problème. Dès que j'essaie de bouger l'image, elle prend tout de suite la place de l'autre image,mais ensuite je peux bouger l'image comme il me semble, car il n'y a pas d'autre image. c'est quoi le problème???
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
heu oui toutes les images peuvent bouger puisque c'est dans la même fonction sauf si visible est à false (considérée comme étant prise)
une image prend une autre image si la distance est suffisamment proche,
tolérance tx et ty que j'ai pris au quart de l'image, à modifier si nécessaire
alors que faut-il faire ?
faire une table qui nous dira pour chaque image si elle peut bouger ou pas ?

If table(Index) = False then Exit Sub

Daniel
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
il me paraît bien compliquer ton test:

If (Image1(i).Left + Image1(i).Width > Image1(j).Left And Image1(i).Left + Image1(i).Width < Image1(j).Left + Image1(j).Width And Image1(i).Top > Image1(j).Top And Image1(i).Top < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left > Image1(j).Left And Image1(i).Left < Image1(j).Left + Image1(j).Width And Image1(i).Top > Image1(j).Top And Image1(i).Top < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left + Image1(i).Width > Image1(j).Left And Image1(i).Left + Image1(i).Width < Image1(j).Left + Image1(j).Width And Image1(i).Top + Image1(i).Height > Image1(j).Top And Image1(i).Top + Image1(i).Height < Image1(j).Top + Image1(j).Height) Or (Image1(i).Left > Image1(j).Left And Image1(i).Left < Image1(j).Left + Image1(j).Width And Image1(i).Top + Image1(i).Height > Image1(j).Top And Image1(i).Top + Image1(i).Height < Image1(j).Top + Image1(j).Height) Then

en supposant que toutes les images ont la même taille, j'ai la même chose avec ça:

Private Sub Form_Load()
tx = Image1(0).Width
ty = Image1(0).Height
End Sub
' dx, dy et tx, ty doivent être dans la même unité
dx = Abs(Image1(j).Left - Image1(i).Left)
dy = Abs(Image1(j).Top - Image1(i).Top)
If dx < tx And dy < ty Then

Daniel
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

C'est certain que c'est bon si ton image que tu bouge est à droite, mais meme la une fois que ton image dépasse l'autre, meme si elle n'est pas par dessus, elle prend l'image de l'autre. Ce test vérifie si le moindre coin est dans l'autre image. Ce que tu fait ne fait que vérifier si ton image est au dessus à gauche. Pas si elle est sur l'image. En fait, le code que j'ai écrit est le même que pour un test d'un objet qui entre en collision avec un autre. C'est pour cela que ça fonctionne. Test le mien avec le tien et cela en faisant bouger les deux image, pas seulement une seule et tu verra la différence.
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
31
j'ai testé ma méthode, elle marche très bien, un seul pixel en contact et c'est la collision ...
mais bon en voici une autre, comme elle est basée sur les API il faut les unités en pixels, donc Me.Scalemode = 3

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long

Dim R1 As RECT
Dim R2 As RECT
Dim R3 As RECT

If Bool = True Then
If Not table(Index) Then Exit Sub
i = Index
Image1(i).Move Image1(i).Left + dx, Image1(i).Top + dy
With Image1(i)
SetRect R1, .Left, .Top, .Left + .Width - 1, .Top + .Height - 1
End With
For j = 0 To Image1.Count - 1
If j <> i And Image1(j).Picture <> Image1(i).Picture Then
With Image1(j)
SetRect R2, .Left, .Top, .Left + .Width - 1, .Top + .Height - 1
End With
IntersectRect(R3, R1, R2)
If R3.Left > 0 Then
Image1(j).Picture = Image1(i).Picture
Image1(i).Picture = Nothing
End If
End If
Next j
End If

Daniel
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010

En tout, cas on ne s'estinera pas sur ce ça. lol. J'ai essayer ta dernière technique, mais comme je n'ai jamais utilisé les API, je ne sais pas comment ça fonctionne, sinon je ne doute pas du bon résultat.