Author  

Language  

Operating Systems  

Option Explicit

' The NMHDR structure contains information about a notification message. The pointer
' to this structure is specified as the lParam member of the WM_NOTIFY message.
Private Type NMHDR
    hwndFrom As Long ' Window handle of control sending message
    idFrom As Long ' Identifier of control sending message
    code As Long ' Specifies the notification code
End Type

Public Const GWL_WNDPROC = -4
Public Const WM_USER = &H400
Public Const WM_NOTIFY = &H4E
Public Const OCM__BASE = (WM_USER + &H1C00)
Public Const OCM_NOTIFY = (OCM__BASE + WM_NOTIFY)
Public Const LVN_FIRST = -100&
Public Const LVN_ENDLABELEDIT = (LVN_FIRST - 6)

Public 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
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, _
    Source As Any, ByVal Length As Long)

Private lpPrevWndProc As Long
Private lngHWnd As Long

Public Sub Hook(hwnd As Long)
    lngHWnd = hwnd
    lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHook()
    Dim lngReturnValue As Long

    lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim nmh As NMHDR

    Select Case uMsg

    ' ==========================================
    ' Process ListView notification messages reflected back to
    ' the ListView from it's parent OLE control reflector window.

    Case OCM_NOTIFY
        ' Fill the NMHDR struct
        CopyMemory nmh, ByVal lParam, Len(nmh)
        Select Case nmh.code
        Case LVN_ENDLABELEDIT
            Debug.Print "Label Edit Ended"
            frmSubclassLV.lvPostalAreas.Sorted = True
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
            UnHook
        End Select ' nmh.code
    Case Else
        WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)

    End Select ' uMsg

End Function

'create a form with two Command Buttons ("Add Item" and "Rename Item")
'and a ListView named lvPostalAreas with two columns ("Postal Areas" and "Sort Key")

Option Explicit

Private Sub Form_Load()
    With lvPostalAreas
        .ColumnHeaders.Add , , "Postal Areas"
        .ColumnHeaders.Add , , "Sort Key"
        .SortKey = 1
        .ColumnHeaders(2).Width = 1440
    End With
End Sub

Private Sub Command1_Click()
    Dim li As ListItem

    'add item
    With lvPostalAreas

        'This is the important bit I was concerned with regarding needing to subclass the Listview.
        'I want my list to sort immediately after the editing of the label (by setting .Sort = True) -
        'regardless of whether editing was cancelled or not. Currently the Listview doesn't provide
        'such an event - the afterlabeledit event only fires if label editing hasn't been cancelled
        .Sorted = False

        Set li = .ListItems.Add(, , "SK")
        li.SubItems(1) = Right$("00000000" & "1", 8)
        .ListItems(.ListItems.Count).Selected = True
        .SetFocus
        .StartLabelEdit
    End With

End Sub

Private Sub Command2_Click()
    'rename item
    With lvPostalAreas
        .SetFocus
        .StartLabelEdit
    End With
End Sub

Private Sub lvPostalAreas_BeforeLabelEdit(Cancel As Integer)
    Hook lvPostalAreas.hwnd
End Sub

Private Sub lvPostalAreas_AfterLabelEdit(Cancel As Integer, NewString As String)
    Dim strPostalArea As String
    Dim lgChrCount As Long
    Dim strChr As String
    Dim li As ListItem
    Dim lgPostalArea As Long

    With lvPostalAreas
        Set li = .SelectedItem
        strPostalArea = NewString
        Debug.Print NewString
        Do
            lgChrCount = lgChrCount + 1
            strChr = Mid$(strPostalArea, lgChrCount, 1)
            If Len(strChr) = 0 Then Exit Do
            If strChr Like "#" Then
                strPostalArea = Right$(strPostalArea, Len(strPostalArea) - (lgChrCount - 1))
                lgPostalArea = Val(strPostalArea)
                lgPostalArea = lgPostalArea + 1
                strPostalArea = CStr(lgPostalArea)
                li.SubItems(1) = Right$("00000000" & strPostalArea, 8)
                Exit Do
            End If
        Loop

        .Sorted = True
    End With

End Sub