mrdep1978
Messages postés402Date d'inscriptionjeudi 25 novembre 2004StatutMembreDernière intervention 7 juin 20097 2 févr. 2005 à 14:58
J'en ai un peu bavé, mais voila ce que je pense être un bon début :
Je copie un élément de la listview1 vers la listview2
Je l'ai fait en VBA, d'où le UserForm_Initialize à la place du Form_Load.
Sinon le reste doit être identique à VB6
Option Explicit
Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
'Démarre le drag/drop si l'utilsateur a cliqué sur le bouton gauche
If Button = 1 Then
ListView1.OLEDrag
End If
End Sub
Private Sub ListView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
'Teste si un élément est sélectionné
If Not ListView1.SelectedItem Is Nothing Then
'Récupère les données de l'élément sélectionné
Data.SetData ListView1.SelectedItem.SubItems(2) & "@" & ListView1.SelectedItem.SubItems(3)
AllowedEffects = 1
Else
Data.Clear
End If
End Sub
Private Sub ListView2_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim ls_Result() As String
Dim li_Item As ListItem
'Fin du drag&drop
'Récupère les données sauvegardées
ls_Result = Split(Data.GetData(1), "@")
'Ajoute l'élément à la liste
Set li_Item = ListView2.ListItems.Add(, , ls_Result(0))
li_Item.SubItems(1) = ls_Result(1)
li_Item.Selected = True
li_Item.EnsureVisible
End Sub
Private Sub UserForm_Initialize()
Dim li_Item As ListItem
With ListView1
.View = lvwReport
.LabelEdit = lvwManual
.FullRowSelect = True
.HideSelection = False
.OLEDragMode = ccOLEDragManual
.OLEDropMode = ccOLEDropManual
.ColumnHeaders.Add , "Colonne1", "Col 1"
.ColumnHeaders.Add , "Colonne2", "Col 2"
.ColumnHeaders.Add , "Colonne3", "Col 3"
Set li_Item = .ListItems.Add(, , "texte1")
li_Item.SubItems(1) = "coucou"
li_Item.SubItems(2) = "bonjour"
Set li_Item = .ListItems.Add(, , "texte2")
li_Item.SubItems(1) = "salut"
li_Item.SubItems(2) = "ca va"
End With
With ListView2
.View = lvwReport
.FullRowSelect = True
.HideSelection = False
.LabelEdit = lvwManual
.OLEDragMode = ccOLEDragManual
.OLEDropMode = ccOLEDropManual
.ColumnHeaders.Add , "Colonne1", "Col 1"
.ColumnHeaders.Add , "Colonne2", "Col 2"
.ColumnHeaders.Add , "Colonne3", "Col 3"
Set li_Item = .ListItems.Add(, , "texte3")
li_Item.SubItems(1) = "ok"
li_Item.SubItems(2) = "ko"
End With
End Sub
mrdep1978
Messages postés402Date d'inscriptionjeudi 25 novembre 2004StatutMembreDernière intervention 7 juin 20097 2 févr. 2005 à 21:02
Oublie ce que j'ai dit sur les similarités VB / VBA. Je viens de le faire en VB chez moi et ça n'a plus gd chose à voir. En VBA, je n'avais accès qu'aux événements et méthodes OLEDrag*.
En VB j'ai directement accès aux événements et méthodes Drag... Va falloir que je jette un oeil sur les versions de mes ocx
Au préalable, je te suggère de mettre une zolie icone dans la propriété ListView1.DragIcon, sinon ça donne un effet un peu à chier
Option Explicit
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
ListView1.Drag vbBeginDrag
End If
End Sub
Private Sub ListView2_DragDrop(Source As Control, x As Single, y As Single)
Dim li_Item As ListItem
Dim li_Item2 As ListItem
'Se déclenche qd on relache la souris pdt un drag/drop
Set li_Item = Source.SelectedItem
'Si un noeud est sélectionné, on ajoute l'élément avt ce noeud, sinon on l'ajoute à la fin
If ListView2.SelectedItem Is Nothing Then
'Ajoute à la fin
Set li_Item2 = ListView2.ListItems.Add(, , li_Item.SubItems(1))
Else
'Ajoute avant la sélection
Set li_Item2 = ListView2.ListItems.Add(ListView2.SelectedItem.Index, , li_Item.SubItems(1))
End If
li_Item2.SubItems(1) = li_Item.SubItems(2)
listview1.Drag vbEndDrag
End Sub
Private Sub ListView2_DragOver(Source As Control, x As Single, y As Single, State As Integer)
Dim li_Item As ListItem
'Se déclenche quand on passe au dessus de listview2 pdt un drag/drop
'Récupère le noeud au dessus duquel le curseur passe
Set li_Item = ListView2.HitTest(x, y)
If Not li_Item Is Nothing Then
li_Item.Selected = True
Else
'Si on n'est au dessus d'aucun noeud, on déselectionne le dernier noeud sélectionné
If Not ListView2.SelectedItem Is Nothing Then
ListView2.SelectedItem.Selected = False
Set ListView2.SelectedItem = Nothing
End If
End If
End Sub
Private Sub Form_Load()
Dim li_Item As ListItem
With ListView1
.View = lvwReport
.LabelEdit = lvwManual
.FullRowSelect = True
.HideSelection = False
.DragMode = DragModeConstants.vbManual
.ColumnHeaders.Add , "Colonne1", "Col 1"
.ColumnHeaders.Add , "Colonne2", "Col 2"
.ColumnHeaders.Add , "Colonne3", "Col 3"
Set li_Item = .ListItems.Add(, , "texte1")
li_Item.SubItems(1) = "coucou"
li_Item.SubItems(2) = "bonjour"
Set li_Item = .ListItems.Add(, , "texte2")
li_Item.SubItems(1) = "salut"
li_Item.SubItems(2) = "ca va"
End With
With ListView2
.View = lvwReport
.DragMode = DragModeConstants.vbManual
.FullRowSelect = True
.HideSelection = False
.LabelEdit = lvwManual
.ColumnHeaders.Add , "Colonne1", "Col 1"
.ColumnHeaders.Add , "Colonne2", "Col 2"
.ColumnHeaders.Add , "Colonne3", "Col 3"
Set li_Item = .ListItems.Add(, , "texte3")
li_Item.SubItems(1) = "ok"
li_Item.SubItems(2) = "ko"
End With
End Sub
mrdep1978
Messages postés402Date d'inscriptionjeudi 25 novembre 2004StatutMembreDernière intervention 7 juin 20097 2 févr. 2005 à 21:55
Ah, ce coup ci, il faut vraiment utiliser le OLEDrag...
J'ai ajouté ceci dans mon Form_Load :
with listview1
Set li_Item = .ListItems.Add(, , "Test")
'Chemin du fichier. si tu ne veux pas le voir affiché, tu peux toujours utiliser li_Item.Tag au lieu de li_Item.SubItems(1)
li_Item.SubItems(1) = "c:\test.ini"
end with
Modifié le MouseMove
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
'ListView1.Drag vbBeginDrag
ListView1.OLEDrag
End If
End Sub
Et ajouté l'événement OLEStartDrag
Private Sub ListView1_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)
Data.Clear
Data.SetData , 15
'ListView1.SelectedItem.SubItems(1) contient le chemin du fichier
Data.Files.Add ListView1.SelectedItem.SubItems(1)
AllowedEffects = vbDropEffectCopy
End Sub