在VB中新建一个工程，放一个文本框与ListView，输入如下代码：
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As KeyCodeConstants) As Integer
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
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 Const LVI_NOITEM = -1
Private Const LVM_FIRST = &H1000
Private Const LVM_GETSUBITEMRECT = (LVM_FIRST + 56)
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
Private Const LVIR_ICON = 1
Private Const LVIR_LABEL = 2
Private Type LVHITTESTINFO
pt As POINTAPI
flags As Long
iItem As Long
iSubItem As Long
End Type
Private 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
Private Function ListView_SubItemHitTest(hWnd As Long, plvhti As LVHITTESTINFO) As Long
ListView_SubItemHitTest = SendMessage(hWnd, LVM_SUBITEMHITTEST, 0, plvhti)
End Function
Private Sub Form_Load()
Dim i As Long
Dim item As ListItem
'数据准备
With ListView1
.HideSelection = False
.View = lvwReport
For i = 1 To 4
.ColumnHeaders.Add Text:="column" & i
Next
For i = 0 To &H3F
Set item = .ListItems.Add(, , "item" & i)
item.SubItems(1) = i * 10
item.SubItems(2) = i * 100
item.SubItems(3) = i * 1000
Next
End With
Text1.ZOrder 0
End Sub
Private Sub ListView1_DblClick()
Dim lvhti As LVHITTESTINFO
Dim rc As RECT
'检测是否是鼠标左键
If (GetKeyState(vbKeyLButton) And &H8000) Then
'获取鼠标当前位置
GetCursorPos lvhti.pt
'转换到ListView中的位置
ScreenToClient ListView1.hWnd, lvhti.pt
If (ListView_SubItemHitTest(ListView1.hWnd, lvhti) <> LVI_NOITEM) Then
'点击项目
If lvhti.iSubItem Then
'是子项
If ListView_GetSubItemRect(ListView1.hWnd, lvhti.iItem, lvhti.iSubItem, LVIR_LABEL, rc) Then
' 也可以把文件框设到ListView中
' SetParent Text1.hWnd, ListView1.hWnd
MapWindowPoints ListView1.hWnd, hWnd, rc, 2
Text1.Move (rc.Left + 4) * Screen.TwipsPerPixelX, _
rc.Top * Screen.TwipsPerPixelY, _
(rc.Right - rc.Left) * Screen.TwipsPerPixelX, _
(rc.Bottom - rc.Top) * Screen.TwipsPerPixelY
End If
End If
End If
End If
End Sub
