Drag and drop dans la meme listbox

Version imprimable

15/11/2009, 04h51
justgreat

Drag and drop dans la meme listbox

Pouvez vous m'expliquer ou me donner un tutoriel ou exemple de comment faire un Drag and Drop d'un item dans la meme listbox ? j'ai trouvé beaucoup d'exemples sur le net sur le drag and drop d'une liste à une autre, moi je veux dans la meme listbox et de pouvoir réorganiser les items suite au drag and drop

merci par avance
15/11/2009, 12h14
ProgElecT
Salut
Dans mes contributions tu trouveras RecenProjVB6.zip : Menu lanceur de projets pour l'éditeur VB6.
Ce programme contient se que tu demandes.

les parties devant t'intéresser sont,

:arrow: Les variables globales à conserver:
- Dim T As Integer, U As Integer
- Dim SenSS As String
- Dim EncourDrag As Boolean, ModificatioN As Boolean
- Dim Msg$, MsgRecup$
:arrow: Les subs utiles pour drag interne à la liste:
- Public Sub DeselectListe
- Public Sub SuppLignes
- Public Sub RecaleLignes
- Private Sub Timer1_Timer
- Private Sub Form_DragOver
- Private Sub ListArchive_MouseUp (juste la premiére ligne)
- Private Sub ListArchive_DragOver
- Private Sub ListArchive_MouseDown
- Private Sub ListArchive_DragDrop
- Private Sub ListArchive_MouseMove
:arrow: Les subs utiles pour drag externe à la liste
- Private Sub ImgCorbeille_DragOver
- Private Sub ImgCorbeille_DragDrop
Comme il s'agit d'une contribution, il y a du commentaire pour chaque commande importante qui devrait te permettre une adaptation sans trop de problème.
15/11/2009, 15h40
justgreat

Bonjour et merci pour ta réponse,

franchement je n'ai pas parvenu à m'en sortir ! En fait, je lance ton projet , mais j'essaye de faire drag and drop dans la liste, mais ça le fait pas ? es tu sur que dans ce projet le drag and drop fonctionne ?
apparemment c'est trop compliqué pour moi:(
Merci en tout cas de m'avoir répondu, mais j'ai pas réussi à m'en sortir
15/11/2009, 15h58
ProgElecT

Pour le source proposé, il faut sélectionner une ou des lignes puis avec bouton Droit + Ctrl maintenu, déplacement sur une ligne ou doit se faire le déplacement, relever le bouton de la souris, et le tours est joué.
L'essentiel est que tu ais trouvé une solution.
Si resolu, n'oublis pas le bouton :resolu:
16/11/2009, 01h27
justgreat

Merci encore une fois
Oui avec le boutton Ctrl enfoncé , ça fait le drag and drop, il drag le nom du fichier apparement pas tout l'item ...
le seul probleme qui reste est que le trouve que le code assez compliqué ou peut etre qu'il y a beaucoup de chose dont j'ai pas besoin.
Ainsi je préfère garder le sujet ouvert si quelqu'un peut me proposer une solution plus simple, sauf si vous préférez que je met résolu et que je cherche ailleurs, ce n'est pas grave, à vous de me dire.

Cordialement
16/11/2009, 15h23
justgreat

Je pense que j'ai trouvé ce lien qui n'est pas mal :

http://support.microsoft.com/default...;en-us;q167746

Pas bien commenté mais bon je peux le comprendre...Par contre ça c'est uniquement pour déplacer un seul élément, si on veut déplacer plusieurs dans une list multiselect=true , avez vous une idée comment le faire ?
18/11/2009, 03h36
justgreat

J'ai réussi à faire ce que j'ai voulu en utilisant le code de microsoft et en ajoutant une fonction que j'ai créé qui prend en compte les multi select.
Au cas où un jour quelqu'un aura besoin de quelque chose en rapport avec ça , n'hesitez pas à me contacter

ps : au modérateur , dois je fermer maintenant le sujet et le marquer comme résolu ou je le garde ouvert comme ça si quelqu'un un jour a besoin de renseignement concernant le meme sujet il le poste ici ?
20/11/2009, 08h41
OhMonBato

Bonjour,

puisque tu as trouve une solution, le mieux serait de joindre ici ton code et de taguer le sujet comme resolu. C'est le moyen le plus sur et le plus rapide pour d'autres utilisateurs de trouver une solution interessante a un probleme similaire.

voici la solution que j'ai créé en partant de la solution proposer chez microsoft
j'espère que ça peut aider quelqu'un, j'ai pas bien commenté car j'ai pas le temps et chez moi c'est beaucoup plus compliquer car je gère plusieurs liste à la fois, mais là j'ai adapté un peu le code pour les gens qui ont besoin de ça dans une seule liste .... j'espère que ça va être utile pour certains

n'oublié pas d'ajouter une icone pour Drag.icone et n'oublié pas de mettre drag à manuel

Code:

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
Private Sub lst_DragDrop(Source As Control, X As Single, Y As Single)
 
 
 
  If lst.ListCount > 0 Then
 
  lst.Selected(DragIndex) = True
  ListOrganiseItems lst, DragIndex, ListRowCalc(Source, Y)
 
  End If  
 
End Sub
 
 
Private Sub lst_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
 
 
lst.ListIndex = ListRowCalc(lst, Y)
 
End Sub
 
 
 
Private Sub lst_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
 
            If Button = vbLeftButton Then
 
         If lst.ListCount > 0 Then
 
            DragIndex = ListRowCalc(lst, Y)
            lst.Drag
 
            End If  
 
        End If
 
End Sub

dans un module

Code:

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
#If Win16 Then
      Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal _
                                  wMsg%, ByVal wParam%, lParam As Any)
    #Else
      Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                     (ByVal hWnd As Long, ByVal wMsg As Long, _
                      ByVal wParam As Long, lParam As Long) As Long
    #End If
 
    Function ListRowCalc(lstTemp As Control, ByVal Y As Single) As Integer
       #If Win16 Then
           Const WM_USER = &H400
           Const LB_GETITEMHEIGHT = (WM_USER + 34)
       #Else
           Const LB_GETITEMHEIGHT = &H1A1
           'Determines the height of each item in ListBox control in pixels
       #End If
       Dim ItemHeight As Integer
       ItemHeight = SendMessage(lstTemp.hWnd, LB_GETITEMHEIGHT, 0, 0)
       ListRowCalc = min(((Y / Screen.TwipsPerPixelY) \ ItemHeight) + _
                     lstTemp.TopIndex, lstTemp.ListCount - 1)
    End Function
 
    Function min(X As Integer, Y As Integer) As Integer
         If X > Y Then min = Y Else min = X
    End Function
 
 
 
   Sub ListOrganiseItems(lstTemp As Control, ByVal OldRow As Integer, _
                    ByVal NewRow As Integer)
 
 
   If OldRow = NewRow Then Exit Sub
 
  On Error GoTo err
 
  'la différence entre le NewRow et la fin de la liste pour pouvoir le localiser
  'une fois qu'on supprime des éléments de la liste
 
 
  Dim DifferenceFin As Integer
 
  'la différence entre le NewRow et le début de la liste pour pouvoir le localiser
  'une fois qu'on supprime des éléments de la liste
 
 
  DifferenceFin = (lstTemp.ListCount - 1) - NewRow
 
 
  'on stocke le nombre d'élément supprimer ayant un indexe inférieur et suppérieur à
  'l'élément cible
 
  Dim RemovedBeforeNewRow As Integer
  Dim RemovedAfterNewRow As Integer
 
  RemovedBeforeNewRow = 0
  RemovedAfterNewRow = 0
 
 
 
  'On enleve les elements selectionnés et on les stoque dans un tableau
 
   Dim SelectedIndexes() As String
  ReDim Preserve SelectedIndexes(0) As String
  Dim ind As Integer
  ind = 0
  total = lstTemp.ListCount - 1
 
  'IndiceReel contient l'indexe de l'item de la liste à l'origine avant qu'il soit supprimé
 'comme si c'est un compteur de la liste mais sans tenir en compte des elements qu'on a supprimé
 
  Dim IndiceReel As Integer
  IndiceReel = 0
 
 
i = 0
While i <= total
       If (lstTemp.Selected(i) = True) Then
 
        SelectedIndexes(ind) = lstTemp.List(i)
          'on supprime de la liste les elements selectionnés
 
            lstTemp.RemoveItem (i)
 
 
             If IndiceReel < NewRow Then
             RemovedBeforeNewRow = RemovedBeforeNewRow + 1
 
             Else
 
             If IndiceReel > NewRow Then
             RemovedAfterNewRow = RemovedAfterNewRow + 1
             End If
 
         End If
 
        i = i - 1
        total = total - 1
 
        ReDim Preserve SelectedIndexes(ind + 1) As String
        ind = ind + 1
    End If
i = i + 1
IndiceReel = IndiceReel + 1
Wend
 
 
 
 
'fin stockage des elements selectionnés et leur suppressions des deux listes
 
  'Maintenant il faut classer ces elements qu'on a enlever à leur place
 
 
     Dim cpt As Integer
   Dim NouvellePosition As Integer
     DifferenceFin = DifferenceFin - RemovedAfterNewRow
 
  If OldRow < NewRow Then
 
     'On fait drag vers le bas cad descend dans la liste
 
 
   For cpt = 0 To UBound(SelectedIndexes()) - 1
   NouvellePosition = (lstTemp.ListCount - 1) - DifferenceFin + 1
   programme.lstTemp.AddItem SelectedIndexes(cpt), NouvellePosition
 
   Next cpt
 
   Else ' ===> If OldRow > NewRow Then
 
  For cpt = 0 To UBound(SelectedIndexes()) - 1
 
   NouvellePosition = (lstTemp.ListCount - 1) - DifferenceFin
   programme.lstTemp.AddItem SelectedIndexes(cpt), NouvellePosition
 
   Next cpt
 
 
 
  End If 'If OldRow < NewRow Then
 
Exit Sub
err:
   MsgBox err.Description & " " & err.Number, vbCritical, "Erreur"
 
 
 End Sub

Si quelqu'un a besoin de questions n'hesitez pas...Je vais mettre le sujet à Résolu !