Sujet Précédent Sujet Suivant

GLISSER/DEPOSER AVEC SIMULATION DU DÉPLACEMENT DU TEXTE D' ITEM, D' UNE LISTBOX

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 29 sept. 2006 à 09:34
cs_andrebernard Messages postés 404 Date d'inscription lundi 9 juin 2003 Statut Membre Dernière intervention 4 septembre 2013 - 5 sept. 2007 à 14:44

Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/39729-glisser-deposer-avec-simulation-du-deplacement-du-texte-d-item-d-une-listbox-vers-une-autre-listbox-ou-vers-un-msflexgrid

cs_andrebernard Messages postés 404 Date d'inscription lundi 9 juin 2003 Statut Membre Dernière intervention 4 septembre 2013 1
5 sept. 2007 à 14:44

Bonjour RENFIELD

Alors, j'ai fait tout comme "c'est qu't'a dit",

1/ j'ai rien compris a l'histoire de l'icone a la volée, aurais tu un exemple s'il te plait ?

2/ Pourquoi quand on selectionne une ligne dans le listview on voit tout le listview qui se deplace ?

Merci de ton aide

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const LB_ITEMFROMPOINT As Long = &H1A9

Private Sub Form_Load()
Dim i As Integer
' initialisation des controls
With lstSource
.AddItem "lstSource 1"
.AddItem "lstSource 2"
.AddItem "lstSource 3"
.AddItem "lstSource 4"
.AddItem "lstSource 5"
.AddItem "lstSource 6"
.AddItem "lstSource 7"
End With

With lstCible
.AddItem "lstCible 8"
.AddItem "lstCible 9"
.AddItem "lstCible 10"
End With
With grdCible
.TextMatrix(0, 0) = "grdCible"

For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next
End With
End Sub

Private Sub lstSource_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lstSource.Drag vbBeginDrag
End Sub

Private Sub lstCible_DragDrop(Source As Control, X As Single, Y As Single)
lstCible.AddItem Source.Text
Source.RemoveItem Source.ListIndex
End Sub

Private Sub grdCible_DragDrop(Source As Control, X As Single, Y As Single)
With grdCible
.Row = .MouseRow
.Col = .MouseCol

If .Row >= .FixedRows And .Col >= .FixedCols Then
.Text = Source.Text
.CellBackColor = vbGreen

Source.RemoveItem Source.ListIndex
End If
End With
End Sub

Private Sub cmdTerminer_Click()
Unload Me
End Sub

Public Function GetListItemIndexFromPoint(ByRef Obj As ListBox, ByVal X As Single, ByVal Y As Single) As Integer
Dim Coords As Long
Dim OverIndex As Long

Coords = Obj.Parent.ScaleY(Y, Obj.Parent.ScaleMode, vbPixels) * &H10000 + Obj.Parent.ScaleX(X, Obj.Parent.ScaleMode, vbPixels)
OverIndex = SendMessage(Obj.hwnd, LB_ITEMFROMPOINT, 0&, ByVal Coords)

'# Si le HighWord = 0, un élément a été trouvé
If (OverIndex \ &H10000) = 0 Then
GetListItemIndexFromPoint = OverIndex Mod &H10000
Else
'# Aucun élément n'est survollé...
GetListItemIndexFromPoint = -1
End If
End Function

Dim nIndex As Long
nIndex = GetListItemIndexFromPoint(lstCible, X, Y)
If nIndex > -1 Then
lstCible.AddItem Source.Text, nIndex
Else
lstCible.AddItem Source.Text
End If
Source.RemoveItem Source.ListIndex
End Sub

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
3 oct. 2006 à 07:28

jamais vu... ne signifie pas que c'est impossible ^^

chaibat05 Messages postés 1883 Date d'inscription samedi 1 avril 2006 Statut Membre Dernière intervention 20 novembre 2007 2
2 oct. 2006 à 20:07

Bonsoir Renfield
Si je devais ajouter une icone je le ferais surle UC et pas
avec Drag Drop Standard.Avec ce dernier je n' aurais que
l' icone ou le contour et pas de texte.
Je n' ai jamais vu de texte se déplacer avec un Drag standard.
C' est justement pour ça que j' ai choisi de le personnaliser .

chaibat

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
2 oct. 2006 à 07:46

GetListItemIndexFromPoint ne sert que pour les ListBoxes....
si tu veux dans un UserControl, ajoutes dans celui-ci une fonction HitTest
(comme on en trouve dans un Treeview ou listView)

Pour l'icone, comme te le suggère PCPT, il suffirait de créer une icone dynamiquement, avec le texte de l'element selectionné (ou d'utiliser une icone drag & drop standard, commune a tous les elements)
et de la placer dans la propriété DragIcon de ton controle source

PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
1 oct. 2006 à 13:29

salut,
tu me demandes un commentaire, alors le voici ;)
intéressant, code lisible, çà peut donc servir.
par contre un ico lors du déplacement, le manque se fait ressentir.
problème : lors du simple click sur lstSource (donc début de déplacement sans déposer), le déplacement a tout de même lieu. en fait tu ne vérifies pas la réception du usercontrol.

et pour pouvoir réutiliser le tout, tout çà sous forme de classe withevents çà serait bien pratique.
bon courage ++

chaibat05 Messages postés 1883 Date d'inscription samedi 1 avril 2006 Statut Membre Dernière intervention 20 novembre 2007 2
1 oct. 2006 à 10:43

01/10/2006 09:30

Problème cité dans l' historique des mise à jour résolu.
Bientot une autre mise à jour ...

chaibat

chaibat05 Messages postés 1883 Date d'inscription samedi 1 avril 2006 Statut Membre Dernière intervention 20 novembre 2007 2
1 oct. 2006 à 00:09

Bonsoir Renfield
La Fonction GetListItemIndexFromPoint()
ne marche pas avec le UC.
Merci tout de même.
Elle servira certainement une autre fois.

chaibat

chaibat05 Messages postés 1883 Date d'inscription samedi 1 avril 2006 Statut Membre Dernière intervention 20 novembre 2007 2
29 sept. 2006 à 18:11

Bonjour Renfield
Bonjour Azimengo

J' étais très content de lire vos commentaires respectifs
Pour le dernier je vais tester le code en ce moment même.
Peut être qu' il sera integré dans une prochaine mise à jour
que je finirais probablement ce soir même.Elle comportera
notament l' effet de transparence.

Merci Azimengo pour l' appréciation
Merci Renfield pour la Fonction.

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
29 sept. 2006 à 11:02

Pour insertion de l'item a l'endroit ou on avait 'visé' :

Private Const LB_ITEMFROMPOINT As Long = &H1A9

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Public Function GetListItemIndexFromPoint(ByRef Obj As ListBox, ByVal X As Single, ByVal Y As Single) As Integer
Dim Coords As Long
Dim OverIndex As Long

Coords = Obj.Parent.ScaleY(Y, Obj.Parent.ScaleMode, vbPixels) * &H10000 + Obj.Parent.ScaleX(X, Obj.Parent.ScaleMode, vbPixels)
OverIndex = SendMessage(Obj.hwnd, LB_ITEMFROMPOINT, 0&, ByVal Coords)

'# Si le HighWord = 0, un élément a été trouvé
If (OverIndex \ &H10000) = 0 Then
GetListItemIndexFromPoint = OverIndex Mod &H10000
Else
'# Aucun élément n'est survollé...
GetListItemIndexFromPoint = -1
End If
End Function

Private Sub lstCible_DragDrop(Source As Control, X As Single, Y As Single)
Dim nIndex As Long
nIndex = GetListItemIndexFromPoint(lstCible, X, Y)
If nIndex > -1 Then
lstCible.AddItem Source.Text, nIndex
Else
lstCible.AddItem Source.Text
End If
Source.RemoveItem Source.ListIndex
End Sub

cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
29 sept. 2006 à 10:45

Super Chaibat05, Renfield comme dab plug and play.

Pour l'effet visuel celui de Chaibat05 est interessant.

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 74
29 sept. 2006 à 09:34

Oublie l'instruction End. (décharges plutot ton formulaire)

pour la 'transparence' ajoute simplement une icone dans la propriété DragIcon de la list Source. pas besoin de pictureBox 'trompOeil' supplémentaire. (une icone avec le texte de l'element pourra par exemple être générée à la volée...

Option Explicit

Private Sub Form_Load()
Dim i As Integer
' initialisation des controls
With lstSource
.AddItem "lstSource 1"
.AddItem "lstSource 2"
.AddItem "lstSource 3"
.AddItem "lstSource 4"
.AddItem "lstSource 5"
.AddItem "lstSource 6"
.AddItem "lstSource 7"
End With

With lstCible
.AddItem "lstCible 8"
.AddItem "lstCible 9"
.AddItem "lstCible 10"
End With
With grdCible
.TextMatrix(0, 0) = "grdCible"

For i = 1 To .Cols - 1
.ColWidth(i) = 1200
Next
End With
End Sub

Private Sub lstSource_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
lstSource.Drag vbBeginDrag
End Sub

Private Sub lstCible_DragDrop(Source As Control, X As Single, Y As Single)
lstCible.AddItem Source.Text
Source.RemoveItem Source.ListIndex
End Sub

Private Sub grdCible_DragDrop(Source As Control, X As Single, Y As Single)
With grdCible
.Row = .MouseRow
.Col = .MouseCol

If .Row >= .FixedRows And .Col >= .FixedCols Then
.Text = Source.Text
.CellBackColor = vbGreen

Source.RemoveItem Source.ListIndex
End If
End With
End Sub

Private Sub cmdTerminer_Click()
Unload Me
End Sub

Discussions similaires

coder un Tchat comme roulettechat.fr/chat/texte.php

listbox et items selectionné

Texte aléatoire

Projet jeux d'échecs : déplacement d'une pièce dans une case

listbox et changer une valeur d'un item

Votre réponse

Discussions similaires