Empêcher le déplacement des items d'un listview

Soyez le premier à donner votre avis sur cette source.

Vue 5 601 fois - Téléchargée 650 fois

Télécharger le projet
Commenter

Description

Ce code permet d'empêcher l'utilisateur de déplacer les items à l'intérieur d'un listview vu que VB ne donne pas de propriété pour le faire...

Un message de notification WM_NOTIFY est envoyé avec un LVN_BEGINDRAG à la fenêtre propriétaire du listview. En interceptant ce message et en l'empêchant de parvenir à la fenêtre, on peut empêcher le déplacement des items dans le listview.

Ce code utilise le Subclassing : aussi est il impératif de fermer l'application par la croix de la fenêtre principale et non par le bouton Stop de VB...sinon GENERAL PROTECTION FAULT...De plus, tout subclassing doit être impérativement enlevé avant la fin du programme (Form_Unload)...sinon idem...

Ce code s'inspire de http://www.devx.com/vb2themax/Tip/18444...
Je précise que ce n'est pas un copier-coller...

Source / Exemple : 


Option Explicit

'message de notification pour une fenêtre
Private Const WM_NOTIFY As Long = &H4E

'premier sous message de notification
Private Const LVN_FIRST As Long = -100
'début d'un déplacement bouton gauche sur un ListView
Private Const LVN_BEGINDRAG As Long = (LVN_FIRST - 9)
'début d'un déplacement bouton droit sur un ListView
Private Const LVN_BEGINRDRAG As Long = (LVN_FIRST - 11)
'début d'un défilement sur un ListView
Private Const LVN_BEGINSCROLL As Long = (LVN_FIRST - 80)
'fin d'un défilement sur un ListView
Private Const LVN_ENDSCROLL As Long = (LVN_FIRST - 81)

'fonction de fenêtre pour une fenêtre
Private Const GWL_WNDPROC As Long = -4
'renvoie une des valeurs associées à une fenêtre
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
'modifie une des valeurs associées à une fenêtre
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'appel une procédure de fenêtre
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'copie une zone de mémoire dans une autre
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

'entête d'un message de notification (dans lParam)
Private Type NMHDR
    hwndFrom As Long    'handle de la fenêtre émettrice
    idfrom As Long      'id du contrôle
    code As Long        'code de notification
End Type
Dim lpPrevWnd As Long   'adresse de la procédure de fenêtre avant le hook

'installe un espion sur la fenêtre spécifiée
'===================================
'hWnd : handle de la fenêtre que l'on veux espionner
'bHook : indique si l'on doit ajouter (True) ou supprimer(False) l'espion de la fenêtre
Public Function SubclassWnd(hWnd As Long, bHook As Boolean) As Long
    'si on doit ajouter l'espion
    If bHook Then
        's'il n'y est pas déjà
        If lpPrevWnd = 0 Then
            'on l'ajoute avec SetWindowLong
            lpPrevWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
            'on enregistre l'adresse précédente
            SubclassWnd = lpPrevWnd
        Else
            'sinon rien à faire
            SubclassWnd = 0
        End If
    'sinon
    Else
        'si la fenêtre est espionnée
        If lpPrevWnd Then
            'on retire l'espion avec SetWindowLong
            SubclassWnd = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWnd)
            lpPrevWnd = 0
        Else
            'sinon rien à faire
            SubclassWnd = 0
        End If
    End If
End Function

'procédure espionne de la fenêtre
'=====================================
'hWnd : handle de la fenêtre qui reçoit ce message
'uMsg : message reçu
'wParam : paramètre pour ce message
'lParam : paramètre pour ce message
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'si ce message est un message de notification
    If uMsg = WM_NOTIFY Then
        'on utilise une structure NMHDR pour plus d'infos sur le message
        Dim nmNotify As NMHDR
        
        'on copie le NMLISTVIEW et donc le NMHDR contenu dans la zone mémoire pointée par lParam
        CopyMemory nmNotify, ByVal lParam, Len(nmNotify)
        'si ce message est un message de déplacement dans un listview
        If nmNotify.code = LVN_BEGINDRAG Then
            'on l'élimine
            WindowProc = 1
            Exit Function
        End If
    End If
    'sinon, on passe le message à la fenêtre visée
    WindowProc = CallWindowProc(lpPrevWnd, hWnd, uMsg, wParam, lParam)
End Function

Conclusion :


Le code est commenté...

N'hésitez pas à commenter et à noter...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
Neo.balastik
Messages postés
797
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
 4
Ok, je vois mieux à présent. Bonne source ! -> 8/10
Signaler
yomm
Messages postés
515
Date d'inscription
dimanche 17 février 2002
Statut
Membre
Dernière intervention
10 mars 2008
 2
Rien à dire , ton code me rend un grand service...je suis sur 3 projets en même temps et tu me fais gagner un temps précieux merci à toi...

10/10

merci pour ta réponse à mon problème posé sur le forum
Signaler
ShareVB
Messages postés
2676
Date d'inscription
vendredi 28 juin 2002
Statut
Membre
Dernière intervention
13 janvier 2016
 11
salut

en fait, ca fait la même chose que ce que tu dis à deux exceptions près :
- le curseur reste le pointeur normal
- les évenements OLE ne sont pas déclenchés du tout
> ca transforme le listview en "présentoire figé" (sauf la sélection)

ShareVB
Signaler
Neo.balastik
Messages postés
797
Date d'inscription
jeudi 17 mai 2001
Statut
Membre
Dernière intervention
5 mai 2009
 4
Si nous parlons de la même chose, en faisant ceci, ca règle le problème du déplacement des items dans le listview :

Me.ListView1.OLEDragMode = ccOLEDragAutomatic
Me.ListView1.OLEDropMode = ccOLEDropNone

Si ne n'est pas le cas, qu'est ce que tu veux dire par "EMPÊCHER LE DÉPLACEMENT DES ITEMS D'UN LISTVIEW" ?
S'inscrire maintenant

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.

Du même auteur (ShareVB)