Source code for Issue Number 75

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just create a new Class Module and then paste this source code into it. You should name the class cWindowInfo.

'----------------------------------------------------------------------
'
'   Module Name:    cWindowInfo
'   Written By:     C&D Programming Corp.
'   Create Date:    1/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private mlHandle As Long

Public Caption As String
Public ClassName As String
Public Style As Long
Public IDNumber As Long
Public ParentHandle As Long
'Public ModuleName As String
Public Instance As Long

Private Type POINTAPI
   x As Long
   y As Long
End Type

Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPointXY Lib "User32" _
        Alias "WindowFromPoint" _
        (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Declare Function GetModuleFileName Lib "kernel32" _
        Alias "GetModuleFileNameA" _
        (ByVal hModule As Long, ByVal lpFileName As String, _
            ByVal nSize As Long) As Long

Private Declare Function GetWindowWord Lib "User32" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function GetWindowLong Lib "User32" _
        Alias "GetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function GetParent Lib "User32" (ByVal hWnd 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 Declare Function GetWindowText Lib "User32" _
        Alias "GetWindowTextA" _
        (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Const GWW_HINSTANCE = (-6)
Const GWW_ID = (-12)
Const GWL_STYLE = (-16)

'
'   Returns True if the window the mouse is over is
'   different than the last time this was called.
'
Public Function WindowByMouse() As Boolean
    Dim pt32 As POINTAPI
    Dim x As Long
    Dim y As Long
    Static lLastHandle As Long

    Call GetCursorPos(pt32)
    x = pt32.x
    y = pt32.y
    Handle = WindowFromPointXY(x, y)

    ' If this is a new handle then return true
    If lLastHandle = Handle Then
        WindowByMouse = False
    Else
        lLastHandle = Handle
        WindowByMouse = True
    End If
End Function

Public Property Let Handle(lHandle As Long)
    Dim lRet As Long

    mlHandle = lHandle
    Caption = String(100, " ")
    lRet = GetWindowText(lHandle, Caption, Len(Caption))  ' Window text
    Caption = Left(Caption, lRet)

    ClassName = String(100, " ")
    lRet = GetClassName(lHandle, ClassName, Len(ClassName))       ' Window class name
    ClassName = Left(ClassName, lRet)


    Style = GetWindowLong(lHandle, GWL_STYLE)          ' Window Style

    ParentHandle = GetParent(lHandle)

    IDNumber = 0    ' default value

    ' If there is a parent get more info:
    If ParentHandle <> 0 Then
        ' Get ID of window:
        IDNumber = GetWindowWord(lHandle, CLng(GWW_ID))

        Instance = GetWindowWord(lHandle, CLng(GWW_HINSTANCE))

'       The code to retrieve the module name does not seem to work correctly,
'       use at your own risk.
'
'        If Instance <> 0 Then
'            ' Get module file name:
'            ModuleName = String(140, " ")
'            lRet = GetModuleFileName(Instance, ModuleName, Len(ModuleName))
'            ModuleName = Left(ModuleName, lRet)
'        Else
'            ModuleName = ""
'        End If
    Else
        IDNumber = 0
        Instance = 0
'        ModuleName = ""
    End If
End Property

Public Property Get Handle() As Long
    Handle = mlHandle
End Property