module2.bas

listview的单元格编辑功能

Attribute VB_Name = "Module2"
Option Explicit

Private Const WM_DESTROY = &H2
  Private Const WM_KILLFOCUS = &H8
    
  Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
  Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
  Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
    
  Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  Private Const GWL_WNDPROC = (-4)
    
  Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
  Private Const OLDWNDPROC = "OldWndProc"
  '
    
  Public Function SubClass(hWnd As Long, lpfnNew As Long) As Boolean
      Dim lpfnOld     As Long
      Dim fSuccess     As Boolean
        
      If (GetProp(hWnd, OLDWNDPROC) = 0) Then
          lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, lpfnNew)
          If lpfnOld Then
              fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
          End If
      End If
        
      If fSuccess Then
          SubClass = True
      Else
          If lpfnOld Then Call UnSubClass(hWnd)
          MsgBox "Unable   to   successfully   subclass   &H" & Hex(hWnd), vbCritical
      End If
        
  End Function
    
  Public Function UnSubClass(hWnd As Long) As Boolean
      Dim lpfnOld     As Long
        
      lpfnOld = GetProp(hWnd, OLDWNDPROC)
      If lpfnOld Then
          If RemoveProp(hWnd, OLDWNDPROC) Then
              UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
          End If
      End If
    
  End Function
    
  Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        
      Select Case uMsg
    
          '   ======================================================
          '   Hide   the   TextBox   when   it   loses   focus   (its   LostFocus   event   it   not   fired
          '   when   losing   focus   to   a   window   outside   the   app).
            
          Case WM_KILLFOCUS
              '   OLDWNDPROC   will   be   gone   after   UnSubClass   is   called,   HideTextBox
              '   calls   UnSubClass.
              Call CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
              Call Form1.HideTextBox(True)
              Exit Function
            
          '   ======================================================
          '   Unsubclass   the   window   when   it's   destroyed   in   case   someone   forgot...
            
          Case WM_DESTROY
              '   OLDWNDPROC   will   be   gone   after   UnSubClass   is   called!
              Call CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
              Call UnSubClass(hWnd)
              Exit Function
                
      End Select
        
      WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
        
  End Function