GLISSER/DEPOSER AVEC SIMULATION DU DÉPLACEMENT DU TEXTE D' ITEM, D' UNE LISTBOX VERS UNE AUTRE LISTBOX OU VERS UN MSFLEXGRID.

Commentaire de Renfield le 29/09/2006 09:34:19 administrateur CS

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

Commentaire de Renfield le 29/09/2006 11:02:35 administrateur CS

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

Commentaire de chaibat05 le 01/10/2006 00:09:33

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

chaibat

Commentaire de PCPT le 01/10/2006 13:29:44 administrateur CS

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 ++

Commentaire de chaibat05 le 02/10/2006 20:07:03

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