Option Explicit
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
#End If
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As LongPtr
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
#If Win64 Then
Function PointToLongLong(point As POINTAPI) As LongLong
Dim ll As LongLong
Dim cbLongLong As LongPtr
cbLongLong = LenB(ll)
' make sure the contents will fit
If LenB(point) = cbLongLong Then
CopyMemory ll, point, cbLongLong
End If
PointToLongLong = ll
End Function
#End If
'---------------------------------
'GetControlHandleByWindowFromPoint
'Ne fonctionne pas pour les Controls de UserForms
'première nouvelle :):)
'---------------------------------
Function GetControlHandleByWindowFromPoint(Ctl As Object) As LongPtr
Dim Hold As POINTAPI, clss$, hwnd&, hwndP&
'Position curseur
GetCursorPos Hold
#If Win64 Then
hwnd = WindowFromPoint(PointToLongLong(Hold))
#Else
hwnd = WindowFromPoint(Hold.x, Hold.y)
#End If
'ListBox
Select Case True
Case TypeOf Ctl Is MSForms.ListBox
GetControlHandleByWindowFromPoint = hwnd
Exit Function
Case TypeName(Ctl) = "ComboBox"
clss = Space$(255)
hwndP = GetParent(hwnd)
GetClassName hwndP, clss, 255
If InStr(1, clss, "F3 MdcPopup") = 0 Then hwnd = 0 ' si c'est un popu alors
End Select
GetControlHandleByWindowFromPoint = hwnd
End Function
