WhichColumnSubitem




' From UseNet posting by Peter Dubuque

'

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal lMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const LVM_FIRST = &H1000&
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
Private Const LVHT_NOWHERE = &H1
Private Const LVHT_ONITEMICON = &H2
Private Const LVHT_ONITEMLABEL = &H4
Private Const LVHT_ONITEMSTATEICON = &H8
Private Const LVHT_ONITEM = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or _
LVHT_ONITEMSTATEICON)
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type LVHITTESTINFO
pt As POINTAPI
lFlags As Long
lItem As Long
lSubItem As Long
End Type
'_________________________________________________________

Private Sub HitTestEx(x As Single, y As Single, tHitTest As LVHITTESTINFO)

Dim lResult As Long
Dim lXCoord As Long
Dim lYCoord As Long

' x and y are in twips; convert them to pixels for the API call

lXCoord = x / Screen.TwipsPerPixelX
lYCoord = y / Screen.TwipsPerPixelY

With tHitTest
.lFlags = 0
.lItem = 0
.lSubItem = 0
.pt.x = lXCoord
.pt.y = lYCoord
End With

lResult = SendMessage(ListView1.hwnd, LVM_SUBITEMHITTEST, 0, tHitTest)
End Sub

'_________________________________________________________

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)
Dim tHitTest As LVHITTESTINFO
Dim sLocation As String

HitTestEx x, y, tHitTest

sLocation = "Item " & tHitTest.lItem + 1 & _
", SubItem " & tHitTest.lSubItem

Select Case tHitTest.lFlags
Case LVHT_NOWHERE
sLocation = "Nowhere"
Case LVHT_ONITEMICON
sLocation = sLocation & ", On Icon"
Case LVHT_ONITEMLABEL
sLocation = sLocation & ", On Label"
Case LVHT_ONITEMSTATEICON
sLocation = sLocation & ", On State Icon"
End Select

MsgBox sLocation

End Sub











( whichcolumnsubitem.html )- by Paolo Puglisi - Modifica del 17/12/2023