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.788 |
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