VBA窗体Listview控件完全教程

ivccav

7.高级：Listview动态加载查询数据的实现

在模糊查询数据时，随着每一次在TEXTBOX控件中的输入，数据都源源不断地的显示在Listview控件中，当我们输入的查询关键字还很少时，Listview显示的数据可能会非常的多，数千上万条是正常的。显示这么多数据，需要非常大的计算资源，而实际情况是，我们不可能从这成千上万的数据中去找我们想要的内容，我们会不断的输入可能的关键字信息，逐步缩小搜索结果，最后可能只会剩下几条数据供我们查看。如果我们在查询过程中，在TextBox控件的Change事件中，每次只输出20条或者50条数据，这样效率会明显地提高很多倍。

但，这也带来一个问题——如果我们只记得部分关键字，在我们停止输入关键字时，我们看到的查询结果是否已经完整？假设我们只呈现20条数据，查询速度是快了，但是我们也无法保证查询结果是完整的吧！有没有一种可能，我们每次都只呈现数据是20条，这样，在查询过程中，可以减少很多倍的输出量，如果用户确有需求，通过滚动鼠标中键，或者拖动滚动条，能逐步的把剩下的数据呈现出来？答案是肯定的。我们只要替换Listview的窗口函数，拦截系统发送过来的鼠标滚动消息和滚动条消息，就可以动态地加载数据，而不会担心数据遗漏。

在窗体初始时时，使用GetWindowLong获取Listview原有的窗口函数的地址，用SetWindowLong设置成我们自定义的窗口函数，初始化代码如下。

Private Sub UserForm_Initialize()
    Dim i As Long, n As Long
    arrData = Range("a1").CurrentRegion
    If IsEmpty(arrData) Then Exit Sub
    With ListView1
        .Gridlines = True
        .FullRowSelect = True
        .LabelEdit = lvwManual
        .SmallIcons = ImageList1
        .View = lvwReport
        .Font.Size = 12
        For i = 1 To UBound(arrData, 2)
            .ColumnHeaders.Add , , arrData(1, i), 100
        Next
        AddListItems ListView1, 2, 20 '初始化时加载20条数据，如有的话
        LvmPreWndProc = GetWindowLong(.hwnd, GWL_WNDPROC)
        SetWindowLong .hwnd, GWL_WNDPROC, AddressOf WndProc
    End With
End Sub

自定义的窗口函数WndProc的代码在标准模块中，而不能在窗体中，因为Addressof运算符无法用于类模块中的函数。Addressof返回函数指针，它只对编译时地址确定的函数有效，而类成员函数编译时地址无法确定，而是由用户实例化时动态生成的，因此无法使用。自定义的窗口函数只拦截需要的消息，并做适当的处理，然后把消息还给原窗口函数，让其按原有方式处理消息。因为这些API函数的使用和理解都很简单，我就不一一解释了。

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long) As Long
Public Declare Function GetScrollRange Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, lpMinPos As Long, lpMaxPos As Long) As Long
Public Const SB_VERT = 1
Public Const WM_VSCROLL = &H115
Public Const WM_MOUSEWHEEL = &H20A
Public Const GWL_WNDPROC = (-4)
Public LvmPreWndProc As Long
Public arrData, lngRowIndex As Long

Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lngMinPos As Long, lngMaxPos As Long
    With UserForm1
        Select Case Msg
            Case WM_VSCROLL
                GetScrollRange hwnd, SB_VERT, lngMinPos, lngMaxPos
                If GetScrollPos(hwnd, SB_VERT) > lngMaxPos - 200 Then
                    If lngRowIndex <= UBound(arrData) Then
                        .AddListItems .ListView1, lngRowIndex, 1
                    End If
                End If
            Case WM_MOUSEWHEEL
                If wParam = &HFF880000 Then
                    If lngRowIndex <= UBound(arrData) Then
                        .AddListItems .ListView1, lngRowIndex, 1
                    End If
                End If
        End Select
    End With
    WndProc = CallWindowProc(LvmPreWndProc, hwnd, Msg, wParam, lParam)
End Function

其中，WM_VSCROLL是拖动垂直滚动条消息，WM_MOUSEWHEEL是鼠标滚动建消息，参数wParam = &HFF880000是向下滚动。AddListItems是在窗体中定义的过程，用来往Listview中添加数据，接受3个参数，第一个参数是Listview控件，第二个参数是一个记录上次添加数据结束后数组中位置的长整数，传递这个参数时，数据就从这个位置开始加载，而不会重复加载前面已经加载过的数据，第三个参数是加载数据的条数，这里指定每接受到一次鼠标向下滚动键或拖动Listview垂直滚动条就加载一条数据，其代码如下：

Public Sub AddListItems(lv As ListView, ByVal lngIdx As Long, lngCount As Long)
    Dim i As Long, j As Long, n As Long
    Dim lstitem As ListItem, forecolor As Long
    Dim strKey As String
    If IsEmpty(arrData) Then Exit Sub
    If lngIdx < LBound(arrData) Or lngIdx > UBound(arrData) Then Exit Sub
    If lngCount < 1 Then lngCount = UBound(arrData) '小于1则加载全部
    With lv
        For i = lngIdx To UBound(arrData)
            strKey = arrData(i, 3) & "/" & arrData(i, 4) & "/" & arrData(i, 5)
            If InStr(strKey, UCase(TextBox1)) Then
                n = n + 1
                If n > lngCount Then Exit For
                Set lstitem = .ListItems.Add
                lstitem.Text = arrData(i, 1)
'                forecolor = IIf(lstitem.Index Mod 2, vbRed, vbBlue)
'                lstitem.forecolor = forecolor
                For j = 2 To UBound(arrData, 2)
                    lstitem.SubItems(j - 1) = arrData(i, j)
'                    lstitem.ListSubItems(j - 1).forecolor = forecolor
                Next
            End If
        Next
        If i > UBound(arrData) Then lngRowIndex = i Else lngRowIndex = i + 1
    End With
End Sub

在查询框的Change事件中的代码如下，每次只加载满足条件的20条数据，极大的减少了数据的输出量：
Private Sub TextBox1_Change()
    ListView1.ListItems.Clear
    AddListItems ListView1, 2, 20
End Sub

ivccav

8.高级：Listview排序方法的完美实现(按字符串、数字、日期和二进制排序)

8.1、Listview消息和结构

Listview控件只能按字符串排序。在实际使用过程中，经常需要按数字和日期进行排序，目前多数人的变通的办法是，对于日期，首先把Listview控件中的日期列用Format(“字符串日期”,"yyyy-mm-dd")转化，然后排序，最后经过处理还原成原来的样子；对于数字，则是使用Format(“字符串数字”,"0000000000")转化后再按字符串进行比较，比较排序完，再用Val函数还原成原来的数字。对于日期，问题不大，只是效率低点，但对于数字则有问题，原来需要保留的小数点，包括末尾的0，则可能丢失，如果原来是空，也会转为0，不是原貌了。

微软在开发Listview的时候，没有提供可选的排序方式，但是却提供了API接口，让用户使用自定义的方式进行排序，即：LVM_SORTITEMS消息，只要用SendMessage函数发送一条LVM_SORTITEMS消息，API会返回两个数，你只要通过回调函数告诉API哪个大、哪个小就行了，其他动作都是API完成。关于LVM_SORTITEMS消息，微软官方网站有非常详尽的说明，这里简要解释一下。

LVM_SORTITEMS消息

https://docs.microsoft.com/zh-cn ... trols/lvm-sortitems

LVM_SORTITEMS消息的作用是使用应用程序定义的比较函数（就是自定义的比较函数，以下直接简称为“比较函数”）对Listview控件的ListItem对象进行排序。使用SendMessage函数发送LVM_SORTITEMS消息时，第一个参数wParam传递的是升序还是降序，第二个参数lParam是指向比较函数的指针。在排序操作期间调用比较函数（是一个回调函数），每次需要比较两个ListItem项的相对顺序。发送消息的语句为：

SendMessageLong Listview1.hwnd, LVM_SORTITEMS, SortOrder, AddressOf CompareFunc

如果调用成功则返回True，否则返回False。
比较函数的原型：

int CALLBACK CompareFunc(LPARAM lParam1, LPARAM lParam2, LPARAM lParamSort);

LPARAM1参数是与进行比较的第一个ListItem相关的值，而LPARAM2参数是与进行比较的第一个ListItem相关的值，这些值是在ListItem对象插入到Listview控件时，在ListItem的LV_ITEM结构成员中指定的数值，用这些值可以确定每一个ListItem对象。LVM_SORTITEMS消息的wParam参数传递给比较函数的第三个参数lParamSort。比较函数必须返回1、0和-1中的一个值，如果第一个项目比第二个项目小，返回-1，大则返回1，相等返回0。
看来，首先要确定LPARAM1和LPARAM2所代表的ListItem对象对应列的值，不然无法直接比较。我们先看看文档中提到的LV_ITEM结构是什么。

LV_ITEM结构

https://docs.microsoft.com/en-us ... commctrl-taglvitema
开篇介绍说LV_ITEM结构用于指定或接收 listview项的属性，此结构已被更新，以支持启用项缩进的新掩码值（LVIFIDENT）。这种结构取代了LV_ITEM结构。如果不需要那些新成员，可以使用旧版本的LV_ITEM，以支持早期的操作系统。在VB中，LV_ITEM结构定义为：
Public Type LV_ITEM
    Mask As Long
    Index As Long
    SubItem As Long
    State As Long
    StateMask As Long
    Text As String
    TextMax As Long
    Icon As Long
    Param As Long
    Indent As Long
End Type
结构成员的名称不重要，但最好是有意义的名称，顺序却很重要，数据类型也很重要。

第一个参数Mask是一个掩码，指定该结构的哪些成员要被设置或查找，例如我们要查找Text成员的值，Mask需要设置为LVIF_TEXT。Index是该结构引用项的基于0的索引（行号），SubItem是该结构引用的子项的基于1索引，如果该结构引用的是项而不是子项，则为零（即：第一列的SubItem为0）。Text是项的文本值。

重点来了，微软文档在解释Param参数时说，Param是一个指向Listview项的值，如果你发送LVM_SORTITEMS消息，Listview控件将传递该值给比较函数。你可以使用LVM_FINDITEM消息在一个Listview控件中搜索具有指定Param值的项。

ivccav

LVM_FINDITEM消息

顺藤摸瓜，我们看看LVM_FINDITEM消息的文档，看看这个葫芦瓜里卖的什么药。

https://docs.microsoft.com/zh-cn ... ntrols/lvm-finditem

LVM_FINDITEM消息用于搜索具有指定特性的Listview项的索引值（基于0的行号）。如搜索成功，返回项目的索引，失败则返回-1。wParam参数是以将要开始搜索的项的索引或-1作为搜索的开始。指定的项本身被排除在搜索之外，而lParam是一个指向包含搜索信息的LVFINDINFO结构的指针。

有点小崩溃了没有？还无法得到需要的Text值，还得继续查看文档！

LVFINDINFO结构

https://docs.microsoft.com/en-us ... ctrl-taglvfindinfoa

Public Type LV_FINDINFO
    flags As Long
    pSz As String
    lParam As Long
    pt As POINTAPI
    vkDirection As Long
End Type

LVFINDINFO结构包含了用于搜索Listview项的信息。flags指定要执行的搜索类型。比较函数收到的是PARAM 信息，因此需要把Flags设置为LVFI_PARAM。lParam参数值用于与Listview项的LVITEM结构的PARAM成员进行比较，因此需要把比较函数收到的PARAM赋值给该成员。

得到了索引值，也知道了点击的列号，还需要最后一步，才能获得比较函数收到的PARAM参数代表的值是什么。

LVM_GETITEMTEXT 消息

https://docs.microsoft.com/zh-cn ... ols/lvm-getitemtext

LVM_GETITEMTEXT 消息用于获取Listview项或子项的Text（文本）。参数wParam是Listview项的索引值。lParam是指向LVITEM结构的指针，若要检索项目文本（item text），请将SubItem设置为零，若要检索子项的文本，请将SubItem设置为子项的索引。Text成员指向接收文本的缓冲区，比如Space(32)，TextMax成员指定缓冲区中的字符个数。该消息返回LVITEM结构的Text成员的字符个数。终于看到曙光了！

我们总结一下，排序的过程是：先用SendMessage函数给Listview控件发送一条LVM_SORTITEMS消息，Listview控件会不断回传两个lParam数值给比较函数。lParam是Listview控件每一行数据特有的一个标识，是LV_ITEM结构中的成员。LV_ITEM结构类似于EXCEL单元格，里面的成员就是各种属性，要得到单元格的值，需要知道单元格的行号和列号。根据收到的lParam参数，使用LVM_FINDITEM消息可以获得单元格的行号（索引），在发送LVM_FINDITEM消息时，需要一个LVFINDINFO结构的参数，指定查找的方式。获得了行号，加上单击Listview控件获得的标题序号（列号），就可以使用LVM_GETITEMTEXT消息获得单元格中的值。获得单元格的值之后，就可以在比较函数中判断两个lParam参数所代表的单元格值的大小，并告诉Listview控件。Listview控件根据比较函数的比较结果进行排序。

说明一点，Listview控件中的所有值都是字符串，在比较函数中判断大小时，可用StrComp比较字符串和二进制类型。对于数字，全部把字符串转为双精度，如果该字符串不是数字，就赋值为双精度的最小值，必须先判断是否为数字，不然强制转换时可能报错。对于日期，如果该字符串不能转为日期，则赋值为系统的最小日期CDate(0)。

完整代码如下：

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_FINDITEM As Long = LVM_FIRST + 13
Public Const LVM_GETITEMTEXT As Long = LVM_FIRST + 45
Public Const LVM_SORTITEMS As Long = LVM_FIRST + 48
Public Const LVFI_PARAM As Long = 1
Public Const LVIF_TEXT As Long = 1
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Type LV_ITEM
    Mask As Long
    Index As Long
    SubItem As Long
    State As Long
    StateMask As Long
    Text As String
    TextMax As Long
    Icon As Long
    Param As Long
    Indent As Long
End Type
Public Type LV_FINDINFO
    flags As Long
    pSz As String
    lParam As Long
    pt As POINTAPI
    vkDirection As Long
End Type
Public Enum LVItemTypes
    lvAlphabetic = 0
    lvNumber = 1
    lvDate = 2
    lvBinary = 3
End Enum
Public Enum LVSortTypes
    lvAscending = 0
    lvDescending = 1
End Enum
Public m_lvSortColumn As Long
Public m_lvHWnd As Long
Public m_lvSortType As LVItemTypes

Public Function LvmSort(lv As ListView, ByVal Index As Long, ByVal ItemType As LVItemTypes, ByVal SortOrder As LVSortTypes) As Boolean
    With lv
        .Sorted = False
        .SortKey = Index
        .SortOrder = SortOrder
        m_lvSortColumn = Index
        m_lvSortType = ItemType
        m_lvHWnd = .hwnd
        Call SendMessageLong(.hwnd, LVM_SORTITEMS, SortOrder, AddressOf LvmCompareProc)
    End With
End Function

Private Function LvmCompareProc(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal SortOrder As Long) As Long
    Dim dat1 As Date, dat2 As Date
    Dim dbl1 As Double, dbl2 As Double
    Dim str1 As String, str2 As String
    str1 = LvmGetItemText(lParam1, m_lvHWnd)
    str2 = LvmGetItemText(lParam2, m_lvHWnd)
    Select Case m_lvSortType
        Case lvAlphabetic
            LvmCompareProc = StrComp(str1, str2, vbTextCompare)
        Case lvNumber
            If IsNumeric(str1) Then dbl1 = CDbl(str1) Else dbl1 = -4.94065645841247E-324
            If IsNumeric(str2) Then dbl2 = CDbl(str2) Else dbl2 = -4.94065645841247E-324
            LvmCompareProc = Sgn(dbl1 - dbl2)
        Case lvDate
            If IsDate(str1) Then dat1 = CDate(str1) Else dat1 = CDate(0)
            If IsDate(str2) Then dat2 = CDate(str2) Else dat2 = CDate(0)
            LvmCompareProc = Sgn(dat1 - dat2)
        Case lvBinary
            LvmCompareProc = StrComp(str1, str2, vbBinaryCompare)
        Case Else
            LvmCompareProc = StrComp(str1, str2, vbTextCompare)
    End Select
    If SortOrder = lvDescending Then LvmCompareProc = -LvmCompareProc
End Function

Private Function LvmGetItemText(lParam As Long, hwnd As Long) As String
    Dim tpyFind As LV_FINDINFO
    Dim tpyItem As LV_ITEM
    Dim Index As Long
    Dim lngRet As Long
    With tpyFind
        .flags = LVFI_PARAM
        .lParam = lParam
    End With
    Index = SendMessage(hwnd, LVM_FINDITEM, -1, tpyFind)
    With tpyItem
        .Mask = LVIF_TEXT
        .SubItem = m_lvSortColumn
        .Text = Space(32)
        .TextMax = Len(.Text)
    End With
    lngRet = SendMessage(hwnd, LVM_GETITEMTEXT, Index, tpyItem)
    If lngRet Then LvmGetItemText = Left$(tpyItem.Text, lngRet)
End Function

ivccav

8.2、调用Listview自定义排序程序

在窗体初始化时，定义一个数字存储Listview各列的排序类型，如arrSort = Array(1, 2, 0, 0, 0, 1, 1, 1, 2, 2, 2, 1) '字符=0；数字=1；日期=2；二进制=3，在ListView1_ColumnClick事件中单击Listview的标题即可调用排序程序。有时候我们想在标题上显示排序的标识，如升序显示向上箭头，降序显示向下箭头。怎么办？我的办法很简单，只需在排序的时候把被单击的标题的文字加一个三角形（▲▼）即可，简单实用。做法是，在窗体初始化时，记录Listview控件各列标题的原文字，以便还原：

For i = 1 To .ColumnHeaders.Count
strTitle(i) = .ColumnHeaders(i).Text
Next

ListView1_ColumnClick事件的代码：

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    With ListView1
        For i = 1 To .ColumnHeaders.Count '还原无三角形的标题
            .ColumnHeaders(i).Text = strTitle(i)
        Next
        If .SortKey = ColumnHeader.Index - 1 Then '排序设置，交替执行。每列第一次排序默认升序
            .SortOrder = IIf(.SortOrder, 0, 1)
        Else
            .SortKey = ColumnHeader.Index - 1
            .SortOrder = lvwAscending
        End If
        LvmSort ListView1, .SortKey, arrSort(.SortKey), .SortOrder '调用自定义排序程序
        '在标题上显示升降序三角，也可用ColumnHeader.Icon属性，只要在ImageList放置两个三角形图片
        ColumnHeader.Text = IIf(.SortOrder, "▼" & ColumnHeader.Text, "▲" & ColumnHeader.Text)
    End With
End Sub

在标题上显示三角形，当然也可以用ColumnHeader.Icon属性，只要在Imagelist控件中放置两个三角形或上下箭头图标，根据升序还是降序引用相应的图片索引或关键字即可。如果要在标题中使用图标，在窗体初始化时，指定ColumnHeaderIcons属性，其代码如下：

Listview1.ColumnHeaderIcons = Me.ImageList1

假设Imagelist控件中向上箭头索引为1，向下箭头索引为2，在ListView1_ColumnClick事件中，可以使用如下代码显示上下箭头图标：

ColumnHeader.Icon = IIf(.SortOrder, 2, 1)

Listview的排序只对当次有效，在数据列变化之后，不会自动排序，因此在查询过程中，如果数据行变化了，记得把标题文字还原成原来的样子，或者把标题图标隐藏起来。这些只是一两句代码的事，代码已在附件中，这里就不贴出了。


Listview动态加载数据+Listview完美排序四种+Listview隔行换色（前景色和背景色）完整代码如下：

Listview动态加载数据 四种排序 隔行换色.zip (274.74 KB, 下载次数: 1368)

2018-7-14 21:01 上传

点击文件名下载附件

ivccav

9.高级：Listview可编辑功能的完美实现

我在之前的一篇帖子中已经放出完整代码和使用方法。这里只讲一些设计细节。

http://club.excelhome.net/thread-1423746-1-1.html

要让Listview具有编辑功能，需要一个辅助控件InkEdit，当点击Listview的数据区域时，InkEdit覆盖在Listview之上，输入的数据通过InkEdit传递给Listview对应的“单元格”。该控件跟Textbox差不多，但是它有句柄属性，使用InkEdit的句柄属性，可以实现一些特殊的功能，这样在使用窗体时更自然、方便。

需要解决的核心问题只有3个：

9.1、InkEdit的位置的计算

当单击Listview控件的“单元格”时，InkEdit控件要能出现在正确的地方，其左上角坐标要和Listview控件的单元格左上角坐标一致，高、宽相同，正好覆盖住该单元格。位置计算其实很简单，只是简单的加减乘除运算，甚至不需要任何API。

Listview控件已经提供足够的属性供我们使用。鼠标事件（MouseUp、MouseDown，MouseMove）提供了鼠标相对于Listview顶边和左边的距离（单位：像素），SelectedItem属性提供了该行顶边到Listview顶边的距离（SelectedItem. Top，单位：磅），和该行左边到Listview控件左边的距离（SelectedItem.Left，单位：磅），其中Listview水平滚动条的值等于Abs(.SelectedItem.Left-1.5)。这个1.5磅是固定值，一行数据没有拖动滚动条时，其Left值就是1.5磅。别问我怎么知道的，你自己在窗体上画一个Listview，点击任意数据行或标题栏，把各种Left、Top、Height、Width都放到一个标签里，看一遍就懂其中的奥妙了。获得滚动条的值也可以直接用GetScrollPos函数，非常简单直观。

Listview的标题对象的Left属性则更方便使用，因为使用ColumnHeaders(Index).Left可以直接得到某一列的Left值（把Index前面所有列的宽度加起来也是这个值。标题对象的Left始终是大于等于零的数值，其值是看得到的那部分+水平滚动条卷起来的那部分之和），用Left值减去水平滚动条“卷起来”的部分，就是能肉眼看到的那部分长度。如果鼠标事件中的x值恰好是介于ColumnHeaders(Index).Left和ColumnHeaders(Index)加上该列的宽度 ColumnHeaders(Index).Width之间的数值，那么鼠标位于哪一列也就可以确定了。知道了鼠标点击的列号和行号，就能用InkEdit关联起来，让InkEdit接收到的值赋给该单元格。

先看一张计算InkEdit控件Left值的示意图：



由图可知，要计算InkEdit的Left值，只要知道鼠标点击的是哪一列即可。鼠标事件中的X值是介于被单击列的Left值与Left+Width之间的数值，对标题对象做一个循环，很容易求出单击的列号。鼠标事件中计算单击列号的代码如下：

Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim sngDiff As Single
    Dim sngScrollPos As Single
    Dim sngMousePosX As Single
    With ListView1
        sngScrollPos = sngPixelPerPoint * GetScrollPos(.hWnd, SB_HORZ)
        sngMousePosX = sngPixelPerPoint * x
        For intCol = 1 To .ColumnHeaders.Count
            sngDiff = .ColumnHeaders(intCol).Left - sngScrollPos
            If sngMousePosX > sngDiff And sngMousePosX < sngDiff + .ColumnHeaders(intCol).Width Then Exit For
        Next
        If intCol > .ColumnHeaders.Count Then intCol = 0 '计算失败时，置为零
    End With
End Sub

注意：鼠标事件和API获得的值都是像素值，需要转换成磅。像素和磅之间没有固定的转换关系，和屏幕密度有关。已经写了一个函数计算每像素的磅数。一般情况下，一个像素等于0.75磅。

再看一张计算InkEdit控件Top值的示意图：



InkEdit的Top值计算更简单，直接看图吧。知道了InkEdit的Left和Top，就能把之放到正确的位置，为Listview控件接收修改数据了。因为需要频繁显示InkEdit控件，我做成了单独的过程，代码如下：

Private Sub ShowInkEdit()
    Dim sngScrollPos As Single
    Dim blnInkLocked As Boolean
    With ListView1
        If intCol = 0 Then Exit Sub '点击的列号未计算成功
        If .SelectedItem Is Nothing Then Exit Sub 'Listview列表为空时退出
        sngScrollPos = sngPixelPerPoint * GetScrollPos(.hWnd, SB_HORZ)
        If intCol > 1 Then
           InkEdit1.Text = .SelectedItem.SubItems(intCol - 1)
        Else
           InkEdit1.Text = .SelectedItem.Text
        End If
        InkEdit1.Left = .ColumnHeaders(intCol).Left + .Left + 1.5 - sngScrollPos
        InkEdit1.Top = .Top + .SelectedItem.Top + 1.5
        InkEdit1.Width = .ColumnHeaders(intCol).Width
        InkEdit1.Height = .SelectedItem.Height
        If Len(strAllowEditCol) Then
            blnInkLocked = (InStr(strAllowEditCol, CStr(intCol)) = 0)
        Else
            blnInkLocked = False
        End If
        InkEdit1.Locked = blnInkLocked
        InkEdit1.SelStart = 0
        InkEdit1.SelLength = Len(InkEdit1.Text)
        InkEdit1.SetFocus
    End With
End Sub

变量blnInkLocked是用来计算锁定列的，因为可能需要设定哪些列不可编辑。

有显示InkEdit控件的过程，就有隐藏InkEdit控件的过程，隐藏InkEdit的过程需要同步数据到Listview和数据源，这个需要不同需要自行修改：

'InkEdit控件退出时的处理程序。主要作用是将修改内容同步到Listview和数据源
Private Sub HideInkEdit(Optional ByVal blnSave As Boolean = True)
    With ListView1
        If .SelectedItem Is Nothing Then Exit Sub '如果InkEdit1未失焦时就关闭窗体，必报错。必须加这一句。
        If blnSave Then
            If intCol > 1 Then
                .SelectedItem.SubItems(intCol - 1) = InkEdit1.Text
            Else
                .SelectedItem.Text = InkEdit1.Text
            End If
            Cells(.SelectedItem.SubItems(.ColumnHeaders.Count - 1), intCol) = InkEdit1.Text '将修改数据同步到数据源的代码请放此处！
        End If
    End With
    InkEdit1.Width = 0
End Sub

ivccav

Listview的HitTest是个挺有意思的方法，能返回鼠标位置的ListItem对象，而LVM_SUBITEMHITTEST消息更为强大，能返回鼠标位于某一行某一列的值。这里不是要使用LVM_SUBITEMHITTEST消息计算鼠标所在的行列号，而是想说一下Listview控件的ControlTipText属性和ListItem和ListSubItem对象的TooltipText属性，把鼠标放在其上，能显示信息提示，如图：



可以利用这些属性做提示说明，或者其他用途。该图上的功能实现起来非常简单，一个Listview，一个标签，就够了。代码如下：

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type LVHITTESTINFO
    pt As POINTAPI
    flags As Long
    iItem As Long
    iSubItem As Long
End Type
Private Const LVM_FIRST = &H1000
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)

Private Sub ListView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
    Dim intRow%, intCol%
    Dim lvhti As LVHITTESTINFO
    lvhti.pt.x = x: lvhti.pt.y = y
    If SendMessage(ListView1.hwnd, LVM_SUBITEMHITTEST, 0, lvhti) <> -1 Then
        intRow = lvhti.iItem + 1
        intCol = lvhti.iSubItem + 1
        If intCol > 1 Then
            ListView1.ListItems(intRow).ListSubItems(intCol - 1).TooltipText = "鼠标位于第" & intRow & "行，第" & intCol & "列"
        Else
            ListView1.ListItems(intRow).TooltipText = "鼠标位于第" & intRow & "行，第" & intCol & "列"
        End If
    Else
        ListView1.ControlTipText = "鼠标不在Listview范围内"
    End If

End Sub

Private Sub UserForm_Initialize()
    Dim i%, j%
    With ListView1
        .Gridlines = True
        .FullRowSelect = True
        .LabelEdit = lvwManual
        .SmallIcons = ImageList1
        .View = lvwReport
        .Font.Size = 10
        For i = 1 To 10
            .ColumnHeaders.Add , , "标题" & i, 65
        Next
        For i = 1 To 99
            With .ListItems.Add
                .Text = Format(i, "00行") & " , 01列"
                For j = 2 To 10
                    .SubItems(j - 1) = Format(i, "00行") & " , " & Format(j, "00列")
                Next
            End With
        Next
    End With
End Sub

ivccav

9.2、InkEdit对键盘输入的处理

在修改数据时，如果能使用方向键、回车键、ESC键控制输入，会非常方便。在使用键盘控制InkEdit时，因为期间没有鼠标事件，其位置需要另外计算。

处理回车键和ESC键比较简单，直接用SetFocus让Listview获得焦点，InkEdit退出即可，无需额外处理。处理ESC键时，要指明HideInkEdit过程不要保存修改。

处理向下方向键时，只要当前行不是最后一行，就可以让InkEdit控件一直往下移动，而在处理向上箭头时，只要当前行不是第一行，就一直让InkEdit控件一直往上移动，并用EnsureVisible方法确保InkEdit控价完全可见。

处理向左方向键时，只要不是第一列就可以一直往左移动，而向右时，只要不是最后一列，也可以一直往右移动InkEdit控件。但是左右方向没有EnsureVisible，需要用代码移动水平滚动条，确保InkEdit完全可见。这需要使用API发送LVM_SCROLL消息。LVM_SCROLL消息的使用很简单，传递滚动量就行了。难点是滚动量的计算，计算过程比较抽象，因为想象力不够，我是直接在草稿纸上画出计算公式的，相信你动一下手，也能画出来。

处理按键的代码如下：

'InkEdit控件的按键处理程序
Private Sub InkEdit1_KeyUp(pKey As Long, ByVal ShiftKey As Integer)
    Dim lngItemIndex As Long
    Dim lngColCount As Long
    Dim lngItemCount As Long
    With ListView1
        lngItemIndex = .SelectedItem.Index
        lngColCount = .ColumnHeaders.Count
        lngItemCount = .ListItems.Count
        Select Case pKey
            Case 13 '13=回车键
                blnFlag = True
                .SetFocus
            Case 37 '37=向左键头
                blnFlag = True
                .SetFocus '先触InkEdit1_Exit事件，此后Listview已获焦
                If intCol > 1 Then
                    intCol = intCol - 1
                    ShowInkEditForLRKey 37
                End If
            Case 38 '38=向上键头
                blnFlag = True
                .SetFocus
                If lngItemIndex > 1 Then
                    Set .SelectedItem = .ListItems(lngItemIndex - 1)
                    .SelectedItem.EnsureVisible
                    ShowInkEdit
                End If
            Case 39 '39=向右键头
                blnFlag = True
                .SetFocus
                If intCol < lngColCount Then
                    intCol = intCol + 1
                    ShowInkEditForLRKey 39
                End If
            Case 40 '40=向下箭头
                blnFlag = True
                .SetFocus
                If lngItemIndex < lngItemCount Then
                    Set .SelectedItem = .ListItems(lngItemIndex + 1)
                    .SelectedItem.EnsureVisible
                    ShowInkEdit
                End If
            Case 27  '27 = Esc键，取消修改
                blnFlag = False
                .SetFocus
            Case Else
        End Select
    End With
End Sub

因为左右方向键的处理比较特殊，也很复杂，我写了一个单独的过程，写这个过程前，在脑海中过了很多遍，确保计算是可行的，没有逻辑错误的。代码如下：

'左右方向键处理程序。主要计算是水平滚动条的滚动量，以确保InkEdit可见
Private Sub ShowInkEditForLRKey(ByVal intKey As Integer)
    Dim sngNewInkLeft As Single
    Dim lngScrollAmount As Long
    Dim blnInkLocked As Boolean
    With ListView1
        If intCol = 0 Then Exit Sub
        If .SelectedItem Is Nothing Then Exit Sub
        If intCol > 1 Then
           InkEdit1.Text = .SelectedItem.SubItems(intCol - 1)
        Else
           InkEdit1.Text = .SelectedItem.Text
        End If
        If intKey = 37 Then '向左
            sngNewInkLeft = InkEdit1.Left - .ColumnHeaders(intCol + 1).Width
            If sngNewInkLeft < .Left + 1.5 Then
                lngScrollAmount = CLng((sngNewInkLeft - (.Left + 1.5)) / sngPixelPerPoint) '滚动量，单位像素
                SendMessageLong .hWnd, LVM_SCROLL, lngScrollAmount, 0 '拖动Listview水平滚动条，保持InkEdit可见
                InkEdit1.Left = .Left + 1.5
            Else
                InkEdit1.Left = sngNewInkLeft
            End If
        Else                '向右
            sngNewInkLeft = InkEdit1.Left + .ColumnHeaders(intCol - 1).Width
            If sngNewInkLeft + .ColumnHeaders(intCol).Width > .Left + .Width Then
                lngScrollAmount = CLng((sngNewInkLeft + .ColumnHeaders(intCol).Width - (.Left + .Width)) / sngPixelPerPoint)
                SendMessageLong .hWnd, LVM_SCROLL, lngScrollAmount, 0
                InkEdit1.Left = .Left + .Width - .ColumnHeaders(intCol).Width
            Else
                InkEdit1.Left = sngNewInkLeft
            End If
        End If
        InkEdit1.Top = .Top + .SelectedItem.Top + 1.5
        InkEdit1.Width = .ColumnHeaders(intCol).Width
        InkEdit1.Height = .SelectedItem.Height
        If Len(strAllowEditCol) Then
            blnInkLocked = (InStr(strAllowEditCol, CStr(intCol)) = 0)
        Else
            blnInkLocked = False
        End If
        InkEdit1.Locked = blnInkLocked
        InkEdit1.SelStart = 0
        InkEdit1.SelLength = Len(InkEdit1.Text)
        InkEdit1.SetFocus
    End With
End Sub

ivccav

9.3、InkEdit和Listview对鼠标输入的处理

在VBA窗体中，没有对鼠标滚动键的处理方法，控件只能识别鼠标左键、右键和中键的点击。点击窗体或者控件的滚动条，也无法使该窗体或控件获得焦点，因此在InkEdit获得焦点时，拖动Listview的滚动条，会出现不合理的情况，InkEdit依然能接收输入，而Listview的数据区域早已改变。

我试了InkEdit和Listview控件的KeyUp、KeyDown、KeyPress，MouseUp、MouseDown、MouseMove事件，都没有办法实现识别鼠标滚动键。没办法，只能使用API了。我的想法是替换控件的窗口过程函数，捕获鼠标消息，然后用SetFocus方法让Listview获得焦点，其他的事，依然让控件原窗口过程函数处理。就这么简单。Listview本来就有句柄属性，而InkEdit也恰好有句柄属性，这就是使用InkEdit的原因。有句柄就可以做一些其他事情。

窗口过程函数基本都是标准模式，先替换原有函数，捕获我们感兴趣的系统消息，做一些适当的处理，然后把消息还给原窗口函数继续处理。

窗口函数的代码如下：

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Const WM_MOUSEWHEEL = &H20A
Public Const GWL_WNDPROC = (-4)
Public LvmPreWndProc As Long
Public InkPreWndProc As Long

Public Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    With UserForm1
        Select Case hWnd
            Case .ListView1.hWnd
                If Msg = WM_VSCROLL Or Msg = WM_HSCROLL Then .ListView1.SetFocus
                WndProc = CallWindowProc(LvmPreWndProc, hWnd, Msg, wParam, lParam)
            Case .InkEdit1.hWnd
                If Msg = WM_MOUSEWHEEL Then .ListView1.SetFocus
                WndProc = CallWindowProc(InkPreWndProc, hWnd, Msg, wParam, lParam)
        End Select
    End With
End Function

WM_VSCROLL是垂直滚动条消息，WM_HSCROLL是水平滚动条消息，WM_MOUSEWHEEL是鼠标滚动键消息，这些都是系统定义的常数，名称只是方便理解，其后面的值才重要，可在API浏览器中获得。CallWindowProc是将消息信息传送给控件原有的窗口过程函数，一定要加这句，不然控件就没有办法工作了，因为你把消息拦截了，又不编写处理程序，控件收不到系统消息，不知道该干嘛。

在窗体初始化时，要记得保存控件原有的窗口过程函数：

   LvmPreWndProc = GetWindowLong(ListView1.hWnd, GWL_WNDPROC)
    InkPreWndProc = GetWindowLong(InkEdit1.hWnd, GWL_WNDPROC)
    SetWindowLong ListView1.hWnd, GWL_WNDPROC, AddressOf WndProc
    SetWindowLong InkEdit1.hWnd, GWL_WNDPROC, AddressOf WndProc
在关闭窗体时，要还原成原有窗口过程函数。

   SetWindowLong ListView1.hWnd, GWL_WNDPROC, LvmPreWndProc
    SetWindowLong InkEdit1.hWnd, GWL_WNDPROC, InkPreWndProc

全文完！（写作时间：耗时约一个星期）

xrj731

佩服,厉害!

吴狄

弄个按开始时间至结束时间段的模糊查询出来学习一下。谢谢