J'utilise une façon de faire du DragDrop un peu special, car j'ai besoin que l'on voit l'image pendant son deplacement,
Mon probleme se situe lors du passage d'un conteneur à un autre, un effet de traces apparait durant le temps du passage de l'un à l'autre, est-il possible d'ameliorer ?
Existe-t-il une façon plus simple de faire du DragDrop avec affichage de l'image durant son deplacement?
J'ai cherché sur plusieurs forums mais, ou j'ai mal formulé ma demande d'infos ou la chose n'est pas possible sous VB6

Pour faire les essais si ca dit à quelqu'un,
sur une Form, mettre 2 PictureBox portant le même nom PictContenaire, indexé 0 et 1
sur l'une des deux y mettre 2 autres PictureBox portant le même nom PictDrag, indexé 0 et 1

La partie '' Form_Load() '' n'est pas necessaire si tout est parametré lors de la construction du projet.
Le code est un peu long, j'ai essayer de mettre des commentaires utiles, il peut etre copié-Collé.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Option Explicit
Dim NewLeft, NewTop As Integer ' pour calculer les nouvelles coordonnées
Dim DemiH, DemiL As Integer ' pour memoriser la demi hauteur et la demi largeur
Dim IndexContenaire As Integer ' pour memoriser le PictContenaire actif
 
Private Sub Form_Load()
'si non initialisé lors de la conception du projet, DEREMER toutes les ligne suivantes
'Me.ScaleMode = vbTwips
'PictDrag(0).ScaleMode = vbTwips: PictDrag(1).ScaleMode = vbTwips
'PictContenaire(0).ScaleMode = vbTwips: PictContenaire(1).ScaleMode = vbTwips
'PictDrag(0).Appearance = 0: PictDrag(1).Appearance = 0
'PictContenaire(0).Appearance = 0: PictContenaire(1).Appearance = 0
'Me.Height = 8805: Me.Width = 6735: Me.Top = 0: Me.Left = 0
'PictContenaire(0).Left = 60: PictContenaire(1).Left = 60
'PictContenaire(0).Width = 6495: PictContenaire(1).Width = 6495
'PictContenaire(0).Height = 2925: PictContenaire(1).Height = 5025
'PictContenaire(0).Top = 60: PictContenaire(1).Top = 3300
'PictDrag(0).AutoSize = True: PictDrag(1).AutoSize = True
 
'chargement de 2 petites images (adapter le chemin ou se trouvent ces images)
'elles doivent etre plus petites que le plus petit des conteneurs
PictDrag(0).Picture = LoadPicture("C:\PersoFrancis\MoyenPersonage2.bmp")
PictDrag(1).Picture = LoadPicture("C:\PersoFrancis\PetitPersonage1.bmp")
End Sub
 
Private Sub PictDrag_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'memorisation des divers elements utiles
DemiH = Int(PictDrag(Index).Height / 2)
DemiL = Int(PictDrag(Index).Width / 2)
IndexContenaire = PictContenaire(PictDrag(Index).Container.Index)
PictDrag(Index).ZOrder 'mise au premier plan
End Sub
 
Private Sub PictDrag_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
 'objet conteneur en TWIPS
 NewLeft = Int((PictDrag(Index).Left + X) - DemiL)
 NewTop = Int((PictDrag(Index).Top + Y) - DemiH)
 
 PictDrag(Index).Move NewLeft, NewTop
 'PictDrag(Index).Refresh '(suivant les performances de l'ordi)
 'passage d'un contenaire à un autre
 If PictDrag(Index).Top > PictContenaire(IndexContenaire).Height - DemiH Then
  IndexContenaire = 1
  Set PictDrag(Index).Container = PictContenaire(IndexContenaire)
 End If
 If PictDrag(Index).Top < -DemiH Then
  IndexContenaire = 0
  Set PictDrag(Index).Container = PictContenaire(IndexContenaire)
 End If
 'PictContenaire(IndexContenaire).Refresh'(suivant les performances de l'ordi)
End If
End Sub
Private Sub PictDrag_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
 'l'affichage du PictDrag doit etre completement dans le PictContenaire
 'donc verification
 If PictDrag(Index).Left < 1 Then NewLeft = 0
 If PictDrag(Index).Left > PictContenaire(IndexContenaire).Width - PictDrag(Index).Width Then
  NewLeft = PictContenaire(IndexContenaire).Width - PictDrag(Index).Width
 End If
 If PictDrag(Index).Top < 1 Then NewTop = 0
 If PictDrag(Index).Top > PictContenaire(IndexContenaire).Height - PictDrag(Index).Height Then
  NewTop = PictContenaire(IndexContenaire).Height - PictDrag(Index).Height
 End If
 PictDrag(Index).Move NewLeft, NewTop
End If
End Sub
En attendant une eventuelle sujestion, merci d'avoir parcourut ce post.

ProgElecT