Click here to copy the following block | Option Explicit
Private Type NMHDR hwndFrom As Long idFrom As Long code As Long 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
Case OCM_NOTIFY 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 Case Else WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function |
Click here to copy the following block |
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
With lvPostalAreas
.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() 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 |
|