Code à ajouter dans un treeview
- il permet d'executer une extantion automatique du node pendant un drag and drop, lorsque la souris reste immobile sur un node pendant 20 cycles
- il permet egalement de scroller en haut ou en bas pendant un drag and drop, suivant les coordonnées de la souris.
A définir les variables :
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim boucledev As Single
Source / Exemple :
Private Sub Xtree_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
'procedure de fin de coller
Dim oTree As TreeView
Set oTree = Me!Xtree.Object
' si pas de node selectionné, selectionner le 1er node déplacé
If oTree.SelectedItem Is Nothing Then Set oTree.SelectedItem = oTree.HitTest(x, y)
'garde le node tant qu'il n'y a pas de collé effectué
Set oTree.DropHighlight = oTree.HitTest(x, y)
'*************** partie de l'automatisation d'ouverture suivant un clycle donnée *******
'oTree.DropHighlight est le node survolé
'compte le nombre de cycle passé sur le node pour executer l'ouverture ou non
If oTree.DropHighlight Is Nothing Then
boucledev = 0
Else
Let boucledev = boucledev + 1
End If
If boucledev = 20 Then
oTree.DropHighlight.Expanded = True
'20 cycles d'attente avant d'executer l'ouverture
boucledev = 0
End If
'****************************************************
Dim myX, myY
myX = x
myY = y
If myY > 9150 Then
SendMessage Xtree.hwnd, 277&, 1&, vbNull 'Scroll vers le haut
Else
If myY < 50 Then
SendMessage Xtree.hwnd, 277&, 0&, vbNull 'Scroll vers le bas
End If
End If
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.