惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

H
Help Net Security
博客园 - Franky
GbyAI
GbyAI
Threat Intelligence Blog | Flashpoint
Threat Intelligence Blog | Flashpoint
爱范儿
爱范儿
IT之家
IT之家
酷 壳 – CoolShell
酷 壳 – CoolShell
aimingoo的专栏
aimingoo的专栏
博客园_首页
MongoDB | Blog
MongoDB | Blog
CTFtime.org: upcoming CTF events
CTFtime.org: upcoming CTF events
Recent Announcements
Recent Announcements
Scott Helme
Scott Helme
有赞技术团队
有赞技术团队
M
MIT News - Artificial intelligence
C
CERT Recently Published Vulnerability Notes
K
KPMG report finds enterprise disconnect between AI and its ROI | CIO
Jina AI
Jina AI
F
Fortinet All Blogs
N
Netflix TechBlog - Medium
L
LangChain Blog
L
LINUX DO - 最新话题
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
cs.AI updates on arXiv.org
cs.AI updates on arXiv.org
H
Hacker News: Front Page
MyScale Blog
MyScale Blog
P
Palo Alto Networks Blog
G
Google Developers Blog
Google DeepMind News
Google DeepMind News
AI
AI
T
Troy Hunt's Blog
Microsoft Azure Blog
Microsoft Azure Blog
阮一峰的网络日志
阮一峰的网络日志
cs.CL updates on arXiv.org
cs.CL updates on arXiv.org
Vercel News
Vercel News
Microsoft Security Blog
Microsoft Security Blog
罗磊的独立博客
S
Secure Thoughts
大猫的无限游戏
大猫的无限游戏
博客园 - 叶小钗
人人都是产品经理
人人都是产品经理
Blog — PlanetScale
Blog — PlanetScale
博客园 - 司徒正美
Apple Machine Learning Research
Apple Machine Learning Research
钛媒体:引领未来商业与生活新知
钛媒体:引领未来商业与生活新知
博客园 - 三生石上(FineUI控件)
S
Security @ Cisco Blogs
Cloudbric
Cloudbric
E
Exploit-DB.com RSS Feed
Attack and Defense Labs
Attack and Defense Labs

博客园 - yzx99

哈希表用于Key与Value的对应 一次让代码更适应变化的经历(续) 一次让代码更适应变化的经历 错误提示与实际问题不符合的案例之一 C#中控件数组的讨论 C#下水晶报表打印自定义纸张 设计模式应用之一:控件清空 自定义StyleCop规则 恢复数据工具比较 SQL公式一直设不成功 不把text或image字段放最后的后果 要显示ASP调试信息,要把IE友好错误去掉 WMI的几种写法 - yzx99 - 博客园 计算机重启脚本 - yzx99 - 博客园 VB6设置进度条颜色 - yzx99 - 博客园 VB6实现ListView各行间隔颜色 - yzx99 - 博客园 SQL查询优化一小例 让普通用户查询安全日志 WMI代码运行错误:80041003
判断ListView双击了子项,并获取其位置与大小
yzx99 · 2009-05-09 · via 博客园 - yzx99

在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