マウスをポインタしたウィンドウの情報

<戻る

ここに載せてあるソースコードは、参考のために載せてあります

サンプルコードは、一番下に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



<戻る

Sample82.lzh


http://hp.vector.co.jp/authors/VA015521/