vb@rchiv · Tipps & Tricks · Verschieben von ListView-Elementen verhindern

Rubrik: Controls · ListView | VB-Versionen: VB5, VB6

12.12.05

Verschieben von ListView-Elementen verhindern Per Subclassing lässt sich das Verschieben von ListView-Elementen durch den Anwender mit wenig Aufwand verhindern.
Autor: Dieter Otter	Bewertung:	Views: 10.782
www.tools4vb.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Das ListView-Control gehört sicherlich zu einem der meist verwendeten Controls in der eigenen VB-Anwendung. Verwendet man das ListView-Control nicht im Report-Modus (Detail-Ansicht), kann der Anwender die einzelnen Elemente zur Laufzeit verschieben, was jedoch nicht immer gewollt ist. Leider verfügt das ListView-Control über keine entsprechende Eigenschaft, die das Verschieben der ListView-Elemente verhindert.

Per Subclassing lässt sich diese Funktionalität jedoch mit wenig Aufwand nachrüsten.

Erstellen Sie ein neues Projekt und platzieren auf die Form ein ListView-Control und ein ImageList-Control. Fügen Sie dem ImageList-Control ein Bildsymbol hinzu.

Option Explicit
 
Private Sub Form_Load()
  Dim i As Long
 
  ' ImageList-Control an das ListView binden
  Set ListView1.Icons = ImageList1
 
  ' Ansicht auf "große Symbole" festlegen
  ListView1.View = lvwIcon
 
  ' ein paar ListView-Elemente erzeugen
  For i = 1 To 20
    ListView1.ListItems.Add , , "Element " & CStr(i), 1
  Next i
 
  ' Subclassing starten
  StartSubclass Me.hWnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' Wichtig! Das Subclassing muss ordnungegemäß
  ' wieder ausgeschaltet werden!!!
  EndSubclass
End Sub

Fügen Sie dem Projekt ein neues Modul mit folgendem Code hinzu:

Option Explicit
 
' Benötigte API-Deklarationen
Private Declare Function SetWindowLong Lib "user32" _
  Alias "SetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" _
  Alias "CallWindowProcA" ( _
  ByVal lpPrevWndFunc As Long, _
  ByVal hWnd As Long, _
  ByVal Msg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
Public Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  pDest As Any, _
  pSource As Any, _
  ByVal dwLength As Long)
 
Private Const WM_NOTIFY = &H4E
Private Const GWL_WNDPROC = -4
 
Private nOldWndProc As Long
Private nHWnd As Long
 
Private Type NMHDR
  hwndFrom As Long
  idFrom As Long
  code As Long
End Type
 
' Nachrichten-Konstanten
Public Const LVN_FIRST = -100&
Public Const LVN_BEGINDRAG = (LVN_FIRST - 9)

Public Sub StartSubclass(hWnd As Long)
  ' Subclassing starten
  nHWnd = hWnd
  nOldWndProc = SetWindowLong(nHWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Dim oMsg As NMHDR
 
  Select Case uMsg
    Case WM_NOTIFY
      ' Message-Struktur füllen
      Call CopyMemory(oMsg, ByVal lParam, Len(oMsg))
      Select Case oMsg.code
        Case LVN_BEGINDRAG
          ' Nachrichtenverarbeitung auf "erledigt" setzen,
          ' so dass der Drag-Vorgang sofort abgebrochen wird
          WindowProc = 1
          Exit Function
      End Select
  End Select
 
  ' Alle anderen Windows-Nachrichten an das Objekt weiterleiten
  WindowProc = CallWindowProc(nOldWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Sub EndSubclass()
  ' Subclassing beenden
  Call SetWindowLong(nHWnd, GWL_WNDPROC, nOldWndProc)
End Sub