VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMonitors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' 0-Based collection of Monitor objects
' Enable "EDaisUseNotifyWnd" conditional compile argument for automatic display change notification.

Private Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
Private Declare Function MonitorFromPoint Lib "User32.dll" (ByRef pt As PointL, ByVal dwFlags As Long) As Long   ' HMONITOR
Private Declare Function MonitorFromRect Lib "User32.dll" (ByRef lprc As RectAPI, ByVal dwFlags As Long) As Long ' HMONITOR
Private Declare Function MonitorFromWindow Lib "User32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long  ' HMONITOR

Private Type RectAPI
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type PointL
    X As Long
    Y As Long
End Type

Public Enum enMonitorFlagsDefaultTo
    mfdtNull = &H0
    mfdtPrimary = &H1
    mfdtNearest = &H2
End Enum

' Constants for GetSystemMetrics()
Private Const SM_XVIRTUALSCREEN  As Long = 76
Private Const SM_YVIRTUALSCREEN  As Long = 77
Private Const SM_CXVIRTUALSCREEN As Long = 78
Private Const SM_CYVIRTUALSCREEN As Long = 79

Private m_Collection As Collection
Private m_NotifyWnd As Long

Public Event Changed()

#If (EDaisUseNotifyWnd) Then
    Public Event DisplayChanged(ByRef inNoRefresh As Boolean)
#End If

' Public properties
Public Property Get Count() As Long
    Count = m_Collection.Count
End Property

Public Property Get Item(ByVal inIdx As Long) As clsMonitor
Attribute Item.VB_UserMemId = 0
    If ((inIdx < 0) Or (inIdx >= m_Collection.Count)) Then Exit Property
    Set Item = m_Collection.Item(inIdx + 1)
End Property

Public Property Get Area() As clsRect
    Set Area = New clsRect
    
    With Area
        .Left = GetSystemMetrics(SM_XVIRTUALSCREEN)
        .Top = GetSystemMetrics(SM_YVIRTUALSCREEN)
        .Right = GetSystemMetrics(SM_CXVIRTUALSCREEN) + .Left
        .Bottom = GetSystemMetrics(SM_CYVIRTUALSCREEN) + .Top
    End With
End Property

' Public methods
Public Sub ReQuery()
    Dim hMonitors() As Long
    Dim NumMonitor As Long
    Dim LoopMonitor As Long
    Dim TempMon As clsMonitor
    
    Call CleanUp
    
    hMonitors() = EDmmEnumMonitors()
    
    On Error Resume Next
    NumMonitor = UBound(hMonitors()) + 1
    On Error GoTo 0
    
    If (NumMonitor > 0) Then
        For LoopMonitor = 0 To NumMonitor - 1
            Set TempMon = New clsMonitor
            TempMon.hMonitor = hMonitors(LoopMonitor)
            Call m_Collection.Add(TempMon)
            Set TempMon = Nothing
        Next LoopMonitor
    End If
    
    RaiseEvent Changed
End Sub

Public Function FromPoint(ByVal inX As Long, ByVal inY As Long, _
    Optional ByVal inFlags As enMonitorFlagsDefaultTo = mfdtNull) As clsMonitor
    Set FromPoint = New clsMonitor
    FromPoint.hMonitor = MonitorFromPoint(NewPoint(inX, inY), inFlags)
End Function

Public Function FromWindow(ByVal inWnd As Long, _
    Optional ByVal inFlags As enMonitorFlagsDefaultTo = mfdtNull) As clsMonitor
    Set FromWindow = New clsMonitor
    FromWindow.hMonitor = MonitorFromWindow(inWnd, inFlags)
End Function

Public Function FromRect(ByRef inRect As clsRect, _
    Optional ByVal inFlags As enMonitorFlagsDefaultTo = mfdtNull) As clsMonitor
    Set FromRect = New clsMonitor
    FromRect.hMonitor = MonitorFromRect(RectToUDT(inRect), inFlags)
End Function

Public Function PrimaryMonitor() As clsMonitor
    For Each PrimaryMonitor In Me ' Enumerate monitors and query primary flag
        If (PrimaryMonitor.PrimaryDisplay) Then Exit Function
    Next PrimaryMonitor
End Function

Public Function NewEnum() As IUnknown ' Required for For ... Each
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
   Set NewEnum = m_Collection.[_NewEnum]
End Function

#If (EDaisUseNotifyWnd) Then ' Friend methods
    Friend Sub OnDisplayChange()
        Dim NoRefresh As Boolean
        
        RaiseEvent DisplayChanged(NoRefresh)
        If (Not NoRefresh) Then Call Me.ReQuery
    End Sub
#End If

' Private methods
Private Sub CleanUp()
    Do While (m_Collection.Count())
        Call m_Collection.Remove(m_Collection.Count())
    Loop
End Sub

Private Function NewPoint(ByVal inX As Long, ByVal inY As Long) As PointL
    NewPoint.X = inX
    NewPoint.Y = inY
End Function

Private Function RectToUDT(ByRef inRect As clsRect) As RectAPI
    With inRect
        RectToUDT.Left = .Left
        RectToUDT.Top = .Top
        RectToUDT.Right = .Right
        RectToUDT.Bottom = .Bottom
    End With
End Function

' Class event handlers
Private Sub Class_Initialize()
    Set m_Collection = New Collection
    
    #If (EDaisUseNotifyWnd) Then ' Create notification window
        m_NotifyWnd = EDmmCreateNotifyWnd(Me)
    #End If
    
    Call Me.ReQuery
End Sub

Private Sub Class_Terminate()
    #If (EDaisUseNotifyWnd) Then
        Call EDmmDestroyNotifyWnd(m_NotifyWnd)
    #End If
    
    Call CleanUp
    Set m_Collection = Nothing
End Sub