' 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 |