DragDrop avec listview

Signaler
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
-
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
-
Slu




j aimerais faire un dragdrop a partir d un listview (en
report) et que le contenu soit composé de plusieurs elements du
listview.




par exemple que le DrapDrop soit compose de l element de la colonne 2 et de la colonne 3 !




Comment faire ?




thx @+

Herve

6 réponses

Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
6
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
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020

Merci



j ai recupere et "adapte" le code pour mon projet mias j ai un soucis il n y a rien dans Data quand je fais le SetData ?!

Herve
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
6
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
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020

Mega Merci !!



Est ce que c la meme chose si je veut faire un DragDrop entre mon App VB et une autre applications (Style PaintShopPro)

En fait j ai une liste de fichier JPG dans un ListView et j aimerais a l aide d un DragDrop glisser un JPG vers PaintShopPro.

Herve
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
6
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
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020

Ben Merci ca marche ....

donc pour faire un DragDrop il faut juste mettre :



Private Sub LW_Fichiers_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

If Button = 1 Then

LW_Fichiers.OLEDrag

End If

End Sub



Private Sub LW_Fichiers_OLEStartDrag(Data As MSComctlLib.DataObject, AllowedEffects As Long)

'Teste si un élément est sélectionné

If Not LW_Fichiers.SelectedItem Is Nothing Then

'Récupère les données de l'élément sélectionné

Data.Clear

Data.SetData , 15

'ListView1.SelectedItem.SubItems(1) contient le chemin du fichier

Data.Files.Add
CheckPath(LW_Fichiers.SelectedItem,
LW_Fichiers.SelectedItem.SubItems(1))

AllowedEffects = vbDropEffectCopy

Else

Data.Clear

End If

End Sub





????????



Encore Merci



Tu as l air vraiment de t y connaitre en VB,VBA peut peux m aider pour un autre de mes probleme !

http://vbfrance.com/forum.v2.aspx?ID=383097



@+

Herve