マウスをポインタしたウィンドウの情報
ここに載せてあるソースコードは、参考のために載せてあります
サンプルコードは、一番下にLZHとしてあります
Option Explicit '構造体の宣言です Private Type POINTAPI X As Long Y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 'API郡の宣言です Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long 'Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer 'Private Const VK_F8 = &H77 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Sub Form_Load() 'ドラッグしてください 'を表示します MessageInfo End Sub 'ドラッグしてください 'を表示します Sub MessageInfo() Picture1.Cls Picture1.Print "マウスをドラッグしてください" End Sub '指定した座標下にあるウィンドウハンドルを取得します Sub GetWnd(ByVal X As Long, ByVal Y As Long) Dim lnghWnd As Long lnghWnd = WindowFromPoint(X, Y) Debug.Print lnghWnd End Sub 'マウス押しました Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'ドラッグが開始したことを示すために '背景色を青にします Picture1.BackColor = vbBlue MessageInfo End Sub 'マウスを動かしました Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lnghWnd As Long Dim lpRect As RECT Dim lpPoint As POINTAPI Dim strText As String Dim strClass As String 'マウスの位置を算出します GetWindowRect Picture1.hwnd, lpRect GetCursorPos lpPoint lpRect.Left = lpRect.Left + X lpRect.Top = lpRect.Top + Y '指定の位置にあるウィンドウハンドルを取得します lnghWnd = WindowFromPoint(lpRect.Left, lpRect.Top) 'GetWindowText,GetClassNameのAPIのために '下準備をします strText = String(255, vbNullChar) strClass = String(255, vbNullChar) 'ウィンドウのCaptionにあたる文字列を取得します GetWindowText lnghWnd, strText, 255& '必要な文字列のみを取得します strText = Mid(strText, 1, InStr(1, strText, vbNullChar) - 1) 'ウィンドウの名前を取得します GetClassName lnghWnd, strClass, 255& strClass = Mid(strClass, 1, InStr(1, strClass, vbNullChar) - 1) 'イミディエイトウィンドウに結果を表示します Debug.Print "(" & lpRect.Left & "," & lpRect.Top & ")" _ & " : hWnd = " & lnghWnd _ & " : Text = """ & strText _ & """ :Class = """ & strClass & """" End Sub 'マウスを放しました Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'ドラッグが終了したことを示すために '背景色を白にします Picture1.BackColor = vbWhite MessageInfo End Sub |