Deplacer un ou plusieurs item d'une listbox vers la position de son choix via la souris


Commenter

Contenu du snippet

Voila, j'avais fait un code pour modifier la position d'un element d'une liste en glissant ce dernier avec la souris, que j'avais fait pour mon lecteur audio, pour pouvoir modifier mes listes en temps réel. Mais on veux parfois deplacer plusieurs chansons vers une autre position. J'ai donc essayer d'ecrire ce code.

C'est peut etre un peu lourd pour des codes qui se declenchent aux evenements Mouse_Up et Mouse_Down , mais je n'ai pas encore trouver d'autre moyen...

La valeur Multiselect de votre liste doit etre à "1 - Simple" . Je vais essayer plus tard, de refaire ce code avec le Multiselect "2 - extended".
L'interet ici du Simple, est qu'il nous est possible de deplacer des items qui ne se suivent pas dans la liste.

Source / Exemple : 


Option Explicit
Dim tmpliste() As String
Dim tmp1() As String
Dim tmp2() As String
Dim i As Integer
Dim nnn As Integer

Private Sub List3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'permet de deselectionner tout par clic droit
If Button = 2 Then
For i = 0 To List3.ListCount - 1
List3.Selected(i) = False
Next i
Exit Sub
End If

'permet de reselectionner l'item sur lequel le deuxieme clic est effectué avant de glisser les objets
x = List3.ListIndex
For i = 0 To List3.ListCount - 1
If List3.Selected(i) = True Then
GoTo reselect
End If
Next i
Exit Sub
reselect:
List3.Selected(x) = True
End Sub

Private Sub List3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then Exit Sub

'on reinitialise les 2 tableaux temporaires
ReDim tmp1(0)
ReDim tmp2(0)

x = List3.ListIndex 'definit la position future des elements
If List3.Selected(x) = False Then 'verifie si la dernier position ne fait pas parti des éléments selectionnés

'boucle qui verifie les éléments séléctionnés,et qui place dans deux tableaux : la valeur de l'éléments séléctionné, et sa position
For i = 0 To List3.ListCount - 1
If List3.Selected(i) = True Then
tmp1(UBound(tmp1)) = List3.List(i)
ReDim Preserve tmp1(UBound(tmp1) + 1)
tmp2(UBound(tmp2)) = i
ReDim Preserve tmp2(UBound(tmp2) + 1)
End If
DoEvents
Next i

If UBound(tmp1) = 0 Then Exit Sub 'si il n'y avait rien de séléctionné, on quitte la procedure

If tmp2(0) <= x Then 'verifie le sens du deplacement

ReDim Preserve tmp2(UBound(tmp2) + 1) 'on ajoute une position inutile au tableau tmp2 pour permettre a la boucle suivante de ne pas generer d'erreur

'boucle qui va supprimer touts les éléments séléctionner de leurs positions initiales :
Do Until UBound(tmp2) = 0
ReDim Preserve tmp2(UBound(tmp2) - 1) 'on decremente le nbre de position du tableau en preservant les données
nnn = UBound(tmp2)
  'boucle pour retrouver l'éléments qui correspond a celui séléctionné dans le tableau tmp1 :
  For i = 0 To List3.ListCount - 1
  If List3.List(i) = tmp1(nnn) Then
  List3.RemoveItem i
  GoTo danext 'evite de continuer inutilement la boucle for i = ...
  End If
  DoEvents
  Next i
danext:
DoEvents
Loop

'boucle qui place les elements aux positions séléctionnés :
For i = 0 To UBound(tmp1) - 1
DoEvents
List3.AddItem tmp1(i), x - UBound(tmp1) + i + 1
Next i

List3.ListIndex = x

Else

ReDim Preserve tmp2(UBound(tmp2) + 1) 'on ajoute une position inutile au tableau tmp2 pour permettre a la boucle suivante de ne pas generer d'erreur

'boucle qui va supprimer touts les éléments séléctionner de leurs positions initiales :
Do Until UBound(tmp2) = 0
ReDim Preserve tmp2(UBound(tmp2) - 1)
nnn = UBound(tmp2)

'boucle pour retrouver l'éléments qui correspond a celui séléctionné dans le tableau tmp1 :
 For i = 0 To List3.ListCount - 1
  If List3.List(i) = tmp1(nnn) Then
  List3.RemoveItem i
  GoTo danext2
  End If
 DoEvents
 Next i
danext2:
DoEvents
Loop

'boucle qui place les elements aux positions séléctionnés :
For i = 0 To UBound(tmp1) - 1
List3.AddItem tmp1(i), x + i
Next i
List3.ListIndex = x

End If
End If
End Sub

Conclusion :


J'ai fait pas mal de tests, je n'ai pas vu d'erreurs.
Faites le moi savoir si vous decouvrez une erreur.

A voir également

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.

Du même auteur (hvb)