DragDrop avec listview
Seth77
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
-
2 févr. 2005 à 10:35
Seth77 Messages postés 572 Date d'inscription mardi 30 avril 2002 Statut Membre Dernière intervention 4 mai 2020 - 2 févr. 2005 à 22:07
Seth77 Messages postés 572 Date d'inscription mardi 30 avril 2002 Statut Membre Dernière intervention 4 mai 2020 - 2 févr. 2005 à 22:07
A voir également:
- Mscomctllib
- Listview vba ✓ - Forum Visual Basic
- Delphi listview ✓ - Forum Delphi / Pascal
- Listview java ✓ - Forum Java
- Listview vb.net ✓ - Forum VB.NET
- Items d'une listview - Forum VB.NET
6 réponses
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
2 févr. 2005 à 14:58
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
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
Seth77
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
1
2 févr. 2005 à 19:06
2 févr. 2005 à 19:06
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
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
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
2 févr. 2005 à 21:02
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
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
Seth77
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
1
2 févr. 2005 à 21:24
2 févr. 2005 à 21:24
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
mrdep1978
Messages postés
402
Date d'inscription
jeudi 25 novembre 2004
Statut
Membre
Dernière intervention
7 juin 2009
7
2 févr. 2005 à 21:55
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
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
Seth77
Messages postés
572
Date d'inscription
mardi 30 avril 2002
Statut
Membre
Dernière intervention
4 mai 2020
1
2 févr. 2005 à 22:07
2 févr. 2005 à 22:07
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
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
