Is Eyedropper Active

The following code determines if eyedropper is active. When eyedropper is active, it creates and displays a window of size 32x32 in which it shows the color beneath the cursor. The class name for this window is "Eyedropper".

Type RECT
    Left As Long
    Tops As Long
    Right As Long
    Bottom As Long
End Type
Declare PtrSafe Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As LongPtr, _
    ByVal lParam As LongPtr) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    lpRect As RECT) As Long
Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    lpdwProcessId As Long) As Long
Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal hwnd As LongPtr, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long

Private Active As Boolean

Private Function WindowProc(ByVal Window As LongPtr, ByVal Cookie As LongPtr) As Boolean
    Dim WR As RECT
    Dim PID As Long
    Dim S As String

    WindowProc = True
    GetWindowRect Window, WR
    If ((WR.Right - WR.Left) = 32) And ((WR.Bottom - WR.Top) = 32) Then
        GetWindowThreadProcessId Window, PID
        If PID = GetCurrentProcessId() Then
            S = Space(500)
            S = Left(S, GetClassName(Window, S, 500))
            If S = "Eyedropper" Then
                Active = True
                WindowProc = False
            End If
        End If
    End If
End Function

Function IsEyedropperActive() As Boolean
    IsEyedropperActive = False
    Active = False
    EnumWindows AddressOf WindowProc, 0
    IsEyedropperActive = Active
    Active = False
End Function

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.