module1.bas

listview的单元格编辑功能

Attribute VB_Name = "Module1"
Option Explicit

Public Type POINTAPI           '   pt
      X   As Long
      Y   As Long
  End Type
    
  Public Type RECT           '   rct
      Left   As Long
      Top   As Long
      Right   As Long
      Bottom   As Long
  End Type
    
  Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As KeyCodeConstants) As Integer
    
  Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
    
  Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                                          (ByVal hWnd As Long, _
                                                          ByVal wMsg As Long, _
                                                          ByVal wParam As Long, _
                                                          lParam As Any) As Long               '   <---
    
  '   ========================================================================
  '   listview   defs
    
  #Const WIN32_IE = &H300
    
  '   user-defined
  Public Const LVI_NOITEM = -1
    
  '   messages
  Public Const LVM_FIRST = &H1000
  #If (WIN32_IE >= &H300) Then
  Public Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
  Public Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
  #End If
    
  '   LVM_GETSUBITEMRECT   rct.Left
  Public Const LVIR_ICON = 1
  Public Const LVIR_LABEL = 2
    
  Public Type LVHITTESTINFO           '   was   LV_HITTESTINFO
      pt   As POINTAPI
      flags   As Long
      iItem   As Long
  #If (WIN32_IE >= &H300) Then
      iSubItem   As Long           '   this   is   was   NOT   in   win95.     valid   only   for   LVM_SUBITEMHITTEST
  #End If
  End Type
    
  '   LVHITTESTINFO   flags
  Public Const LVHT_ONITEMLABEL = &H4
  '
    
  #If (WIN32_IE >= &H300) Then
    
  Public Function ListView_GetSubItemRect(hWnd As Long, iItem As Long, iSubItem As Long, _
                                                                                                                                          code As Long, prc As RECT) As Boolean
      prc.Top = iSubItem
      prc.Left = code
      ListView_GetSubItemRect = SendMessage(hWnd, LVM_GETSUBITEMRECT, ByVal iItem, prc)
  End Function
    
  Public Function ListView_SubItemHitTest(hWnd As Long, plvhti As LVHITTESTINFO) As Long
      ListView_SubItemHitTest = SendMessage(hWnd, LVM_SUBITEMHITTEST, 0, plvhti)
  End Function
    
  #End If       '   '   WIN32_IE   >=   &H300