Drag & Drop, comment faire?
Résolu
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
-
22 janv. 2005 à 18:32
cire2003 Messages postés 101 Date d'inscription samedi 8 novembre 2003 Statut Membre Dernière intervention 8 septembre 2010 - 24 janv. 2005 à 01:46
cire2003 Messages postés 101 Date d'inscription samedi 8 novembre 2003 Statut Membre Dernière intervention 8 septembre 2010 - 24 janv. 2005 à 01:46
13 réponses
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
22 janv. 2005 à 22:55
22 janv. 2005 à 22:55
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
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
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
23 janv. 2005 à 17:17
23 janv. 2005 à 17:17
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
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
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
22 janv. 2005 à 18:49
22 janv. 2005 à 18:49
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
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
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
22 janv. 2005 à 18:57
22 janv. 2005 à 18:57
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
22 janv. 2005 à 19:00
22 janv. 2005 à 19:00
Petit oubli, le problème reste aussi que l'image bouger doit prendre la place d'une autre image.
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
22 janv. 2005 à 19:23
22 janv. 2005 à 19:23
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
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
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
22 janv. 2005 à 21:22
22 janv. 2005 à 21:22
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.)
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
23 janv. 2005 à 14:03
23 janv. 2005 à 14:03
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???
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
23 janv. 2005 à 14:57
23 janv. 2005 à 14:57
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
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
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
23 janv. 2005 à 19:11
23 janv. 2005 à 19:11
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
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
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
23 janv. 2005 à 23:41
23 janv. 2005 à 23:41
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.
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
24 janv. 2005 à 00:30
24 janv. 2005 à 00:30
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
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
cire2003
Messages postés
101
Date d'inscription
samedi 8 novembre 2003
Statut
Membre
Dernière intervention
8 septembre 2010
24 janv. 2005 à 01:46
24 janv. 2005 à 01:46
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.
