Attribute VB_Name = "modListItemHitTest"
Option Explicit

' *** Den Artikel zu diesem Modul finden Sie unter http://www.aboutvb.de/khw/artikel/khwlistitemhittest.htm ***

Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SUBITEMHITTEST As Long = (LVM_FIRST + 57)
Private Const LVM_GETITEMRECT = (LVM_FIRST + 14)
Private Const LVHT_ONITEMICON As Long = &H2
Private Const LVHT_ONITEMLABEL As Long = &H4
Private Const LVHT_ONITEMSTATEICON As Long = &H8
Private Const LVHT_ONITEM As Long = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or LVHT_ONITEMSTATEICON)
Private Const LVIR_BOUNDS = 0

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type LVHITTESTINFO
    pt As POINTAPI
    Flags As Long
    Item As Long
    SubItem  As Long
End Type

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

Public Enum ListItemHitTestSuccessConstants
    lhsNone
    lhsListItem
    lhsListSubItem
End Enum
    
Public Enum ListItemHitTestPartConstants
    lhpNone
    lhpText
    lhpIcon
    lhpCheckBox
    lhpWhiteSpace
End Enum

Public Function ListItemHitTest(ListView As ListView, ByVal x As Single, ByVal y As Single, ListItem As ListItem, ListSubItem As ListSubItem, Part As ListItemHitTestPartConstants, Optional ByVal SelectListItem As Boolean) As ListItemHitTestSuccessConstants
    Dim nHITTESTINFO As LVHITTESTINFO
    Dim nListItem As ListItem
    Dim l As Long
    Dim nRect As RECT
    
    Set ListItem = Nothing
    Set ListSubItem = Nothing
    Part = lhpNone
    With ListView
        If .View <> lvwReport Then
            Exit Function
        End If
        If .ListItems.Count = 0 Then
            Exit Function
        End If
        With nHITTESTINFO
            .pt.x = (x \ Screen.TwipsPerPixelX)
            .pt.y = (y \ Screen.TwipsPerPixelY)
            .Flags = LVHT_ONITEM
        End With
        SendMessage .Hwnd, LVM_SUBITEMHITTEST, 0, nHITTESTINFO
    End With
    Select Case nHITTESTINFO.Item
        Case Is > -1
            Set nListItem = ListView.ListItems(nHITTESTINFO.Item + 1)
        Case Else
            With ListView
                For l = .GetFirstVisible.Index To .ListItems.Count
                    Set nListItem = .ListItems(l)
                    With nListItem
                        Select Case y
                            Case .Top To .Top + .Height
                                Exit For
                            Case Else
                                Set nListItem = Nothing
                        End Select
                    End With
                Next 'l
            End With
            If nListItem Is Nothing Then
                Exit Function
            Else
                nRect.Left = LVIR_BOUNDS
                SendMessage ListView.Hwnd, LVM_GETITEMRECT, nListItem.Index - 1, nRect
                Select Case x \ Screen.TwipsPerPixelX
                    Case nRect.Left To nRect.Right
                        Part = lhpText
                    Case Else
                        Part = lhpWhiteSpace
                End Select
            End If
    End Select
    If nHITTESTINFO.SubItem > 0 Then
        Set ListSubItem = nListItem.ListSubItems(nHITTESTINFO.SubItem)
        ListItemHitTest = lhsListSubItem
    Else
        ListItemHitTest = lhsListItem
    End If
    Select Case nHITTESTINFO.Flags
        Case LVHT_ONITEMSTATEICON
            Part = lhpCheckBox
        Case LVHT_ONITEMICON
            If ListSubItem Is Nothing Then
                Part = lhpIcon
            Else
                If Len(ListSubItem.ReportIcon) Then
                    Part = lhpIcon
                Else
                    Part = lhpText
                End If
            End If
        Case LVHT_ONITEMLABEL
            Part = lhpText
    End Select
    If SelectListItem Then
        nListItem.Selected = True
    End If
    Set ListItem = nListItem
End Function