Need Code Please Help

[Evan]

Hi,

Its pritty simple. I dont know how
to do it though. I need a sub that
will get the x, and y of the position
and then find the control that is
under it. thats it!

[kedaman]

And to get the handle of the window(any child window) your cursor is hovering, you use windowfrompoint

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

GetCursorPos z ' Get Co-ordinets
Debug.? windowfrompoint(z.x,z.y)

if it's over your app you could loop trough all your controls and test their window handles. Won't work for labels, images, shapes and lines though...

[Evan]

No!

I need a sub that
will get the x, and y of the position
and then find the control that is
under it

Notice the later half please!

[YoungBuck]

Here is sort of what you are looking for Evan. Like kedaman's example it doesn't work for image controls, shape controls and any other control that doesn't have a hWnd property

Add this to a module

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Option Explicit

Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Type POINTAPI
        x As Long
        y As Long
End Type

Public Function IsMouseOver(cAny As Control) As Boolean
On Error GoTo x:

    Dim lRet As Long
    Dim rWnd As RECT, ptCurrent As POINTAPI
    
    ' fill rect structure of current Window (control)
    lRet = GetWindowRect(cAny.hwnd, rWnd)
    ' get current cursor position
    lRet = GetCursorPos(ptCurrent)
    ' is cursor in window rect
    lRet = PtInRect(rWnd, ptCurrent.x, ptCurrent.y)
    
    If Not lRet = 0 Then
        
        IsMouseOver = True
        
    Else
        
        IsMouseOver = False
    
    End If
x:
    If Err.Number = 438 Then ' this error will be raised if a control doesn't support the hWnd property
        
        IsMouseOver = False
        
        Exit Function
        
    End If
    
End Function

Add this code to Form1 (also add a label named label1 and a couple of controls to test code with)

Option Explicit

Dim bEndLoop As Boolean

Private Sub Form_Load()
    Dim f As Form, c As Control
    
    'show form
    Me.Show
    
    bEndLoop = False
    
    Do Until bEndLoop = True
        ' Allow other processes to run
        DoEvents
        
        ' loop through each form in project
        For Each f In Forms
            
            ' loop through each control in project
            For Each c In f.Controls
            
                ' if cursor is over control display it's name in label1
                If IsMouseOver(c) Then
                    
                    Label1.Caption = "Mouse is over " & c.Name
                    
                End If
            
            Next c
            
        Next f
    
    Loop
        
End Sub


Private Sub Form_Unload(Cancel As Integer)
    
    ' flag continous loop to end
    bEndLoop = True
    
End Sub

Good Luck!

[Chris]

May be you can try this?

'Put this code under your form mouse move event
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    Debug.Print Get_WindowName
    Debug.Print Get_ClassName
End If
End Sub

'Put this code in a module file
Option Explicit
'API use to get the current mouse pointer location
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'API use to get the window handle where the Mouse pointer is current pointing.
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'API use to retrieve Window Text
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'API use to retrieve Window Class Name
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'API use to retrieve others Window params
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'POINT Structure
Public Type POINTAPI
        X As Long
        Y As Long
End Type
Public xPt As POINTAPI

'Variable
Public dl As Long
Public hWndOver As String
Public WndText As String
Public WndClass As String
Public result As String
Public Function Get_ClassName() As String
GetCursorPos xPt
hWndOver = WindowFromPoint(xPt.X, xPt.Y)
If hWndOver <> 0 Then
    dl = GetClassName(hWndOver, result, 255)
    If dl <> 0 Then
        Get_ClassName = Left(result, InStr(1, result, Chr(0), vbTextCompare) - 1)
    Else
        Get_ClassName = ""
    End If
Else
    Get_ClassName = ""
End If
End Function

Public Function Get_WindowName() As String
GetCursorPos xPt
hWndOver = WindowFromPoint(xPt.X, xPt.Y)
If hWndOver <> 0 Then
    result = String(255, Chr(0))
    dl = GetWindowText(hWndOver, result, 100)
    If dl <> 0 Then
        WndText = Left(result, InStr(1, result, Chr(0), vbTextCompare) - 1)
        Get_WindowName = WndText
    Else
        Get_WindowName = ""
    End If
Else
    Get_WindowName = ""
End If
End Function

Perhaps you can call the GetWindowLong APi function to get more information about the control under your mouse pointer.