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

Private Declare Function GetMonitorInfo Lib "User32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpMI As MonitorInfoEx) As Long
Private Declare Function EnumDisplayDevices Lib "User32.dll" Alias "EnumDisplayDevicesA" (ByVal lpDevice As String, ByVal iDevNum As Long, ByRef lpDisplayDevice As DisplayDevice, ByVal dwFlags As Long) As Long
Private Declare Function ChangeDisplaySettingsEx Lib "User32.dll" Alias "ChangeDisplaySettingsExA" (ByVal lpszDeviceName As String, ByRef lpDevMode As DevMode, ByVal hWnd As Long, ByVal dwFlags As Long, ByRef lParam As Any) As Long
Private Declare Function EnumDisplaySettingsEx Lib "User32.dll" Alias "EnumDisplaySettingsExA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DevMode, ByVal dwFlags As Long) As Long

Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32

Private Type PointL
    X As Long
    Y As Long
End Type

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

Private Type MonitorInfoEx
    cbSize As Long
    rcMonitor As RectAPI
    rcWork As RectAPI
    dwFlags As Long
    szDevice As String * CCHDEVICENAME
End Type

Private Type DisplayDevice
    cb As Long
    DeviceName As String * 32
    DeviceString As String * 128
    StateFlags As Long
    DeviceID As String * 128
    DeviceKey As String * 128
End Type

Private Type DevMode
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmPosition As PointL
    dmDisplayOrientation As Long
    dmDisplayFixedOutput As Long
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName(0 To CCHFORMNAME - 1) As Byte
    dmLogPixels As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Public Enum enDisplayChangeResult
    dcrBadDualView = -6
    dcrBadParam = -5
    dcrBadFlags = -4
    dcrNotUpdated = -3
    dcrBadMode = -2
    dcrFailed = -1
    dcrSuccessful = 0
    dcrRestart = 1
End Enum

Private m_hMonitor As Long
Private m_DisplayName As String
Private m_DeviceString As String
Private m_DeviceID As String
Private m_DeviceKey As String
Private m_PrimaryDisplay As Boolean
Private m_AttachedToDesktop As Boolean
Private m_MirroringDriver As Boolean
Private m_VGACompatible As Boolean
Private m_Removable As Boolean
Private m_ModeSpruned As Boolean
Private m_WorkArea As clsRect
Private m_Area As clsRect
Private m_DisplayModes As Collection

' Flags for MonitorInfoEx structure
Private Const MONITORINFOF_PRIMARY As Long = &H1
Private Const DISPLAY_DEVICE_ATTACHED_TO_DESKTOP As Long = &H1
Private Const DISPLAY_DEVICE_PRIMARY_DEVICE As Long = &H4
Private Const DISPLAY_DEVICE_MIRRORING_DRIVER As Long = &H8
Private Const DISPLAY_DEVICE_VGA_COMPATIBLE As Long = &H10
Private Const DISPLAY_DEVICE_REMOVABLE As Long = &H20
Private Const DISPLAY_DEVICE_MODESPRUNED As Long = &H8000000

Private Const DM_POSITION As Long = &H20
Private Const DM_DISPLAYORIENTATION As Long = &H80 ' XP only
Private Const DM_BITSPERPEL As Long = &H40000
Private Const DM_PELSWIDTH As Long = &H80000
Private Const DM_PELSHEIGHT As Long = &H100000
Private Const DM_DISPLAYFLAGS As Long = &H200000
Private Const DM_DISPLAYFREQUENCY As Long = &H400000
Private Const DM_DISPLAYFIXEDOUTPUT As Long = &H20000000 ' XP only

Private Const ENUM_CURRENT_SETTINGS As Long = -1
Private Const ENUM_REGISTRY_SETTINGS As Long = -2
Private Const EDS_RAWMODE As Long = &H2

Private Const CDS_UPDATEREGISTRY As Long = &H1
Private Const CDS_TEST As Long = &H2
Private Const CDS_FULLSCREEN As Long = &H4
Private Const CDS_GLOBAL As Long = &H8
Private Const CDS_SET_PRIMARY As Long = &H10
Private Const CDS_VIDEOPARAMETERS As Long = &H20
Private Const CDS_NORESET As Long = &H10000000
Private Const CDS_RESET As Long = &H40000000
Private Const CDS_FORCE As Long = &H80000000

Public Property Get hMonitor() As Long
    hMonitor = m_hMonitor
End Property
Public Property Let hMonitor(ByVal inNew As Long)
    m_hMonitor = inNew
    Call ReQuery
End Property

Public Property Get DisplayName() As String
    DisplayName = m_DisplayName
End Property

Public Property Get DeviceString() As String
    DeviceString = m_DeviceString
End Property

Public Property Get DeviceID() As String
    DeviceID = m_DeviceID
End Property

Public Property Get DeviceKey() As String
    DeviceKey = m_DeviceKey
End Property

Public Property Get PrimaryDisplay() As Boolean
    PrimaryDisplay = m_PrimaryDisplay
End Property

Public Property Get AttachedToDesktop() As Boolean
    AttachedToDesktop = m_AttachedToDesktop
End Property

Public Property Get MirroringDriver() As Boolean
    MirroringDriver = m_MirroringDriver
End Property

Public Property Get VGACompatible() As Boolean
    VGACompatible = m_VGACompatible
End Property

Public Property Get Removable() As Boolean
    Removable = m_Removable
End Property

Public Property Get ModeSpruned() As Boolean
    ModeSpruned = m_ModeSpruned
End Property

Public Property Get WorkArea() As clsRect
    Set WorkArea = m_WorkArea
End Property

Public Property Get Area() As clsRect
    Set Area = m_Area
End Property

Public Property Get DisplayModeCount() As Long
    DisplayModeCount = m_DisplayModes.Count
End Property

Public Property Get CurrentDisplayMode() As clsDisplayMode
    Set CurrentDisplayMode = GetDisplayMode(ENUM_CURRENT_SETTINGS)
End Property

Public Property Get RegistryDisplayMode() As clsDisplayMode
    Set RegistryDisplayMode = GetDisplayMode(ENUM_REGISTRY_SETTINGS)
End Property

Public Property Get DisplayMode(ByVal inIdx As Long) As clsDisplayMode
    If ((inIdx >= 0) And (inIdx < m_DisplayModes.Count)) Then _
        Set DisplayMode = m_DisplayModes.Item(inIdx + 1)
End Property

Public Sub ReQuery()
    Dim MonInf As MonitorInfoEx
    Dim DispInf As DisplayDevice
    Dim DevInf As DevMode
    Dim CurNum As Long
    Dim NewMode As clsDisplayMode
    
    Call ClearInfo
    
    MonInf.cbSize = Len(MonInf)
    If (GetMonitorInfo(m_hMonitor, MonInf)) Then
        m_DisplayName = TrimNull(MonInf.szDevice)
        Set m_Area = RectFromUDT(MonInf.rcMonitor)
        Set m_WorkArea = RectFromUDT(MonInf.rcWork)
        m_PrimaryDisplay = CBool(MonInf.dwFlags And MONITORINFOF_PRIMARY)
        
        DispInf.cb = Len(DispInf)
        If (EnumDisplayDevices(m_DisplayName, 0, DispInf, 0) <> 0) Then
            m_DeviceString = TrimNull(DispInf.DeviceString)
            m_DeviceKey = TrimNull(DispInf.DeviceKey)
            m_DeviceID = TrimNull(DispInf.DeviceID)
            
            ' Set flags
            m_AttachedToDesktop = CBool(DispInf.StateFlags And DISPLAY_DEVICE_ATTACHED_TO_DESKTOP)
            m_MirroringDriver = CBool(DispInf.StateFlags And DISPLAY_DEVICE_MIRRORING_DRIVER)
            m_VGACompatible = CBool(DispInf.StateFlags And DISPLAY_DEVICE_VGA_COMPATIBLE)
            m_ModeSpruned = CBool(DispInf.StateFlags And DISPLAY_DEVICE_MODESPRUNED)
            m_Removable = CBool(DispInf.StateFlags And DISPLAY_DEVICE_REMOVABLE)
        End If
        
        Do ' Enumerate display modes
            Set NewMode = GetDisplayMode(CurNum)
            If (NewMode Is Nothing) Then Exit Do
            
            If (NewMode.IsValid()) Then _
                Call m_DisplayModes.Add(NewMode) Else _
                CurNum = -10
            Set NewMode = Nothing
            
            CurNum = CurNum + 1
        Loop While (CurNum > 0)
    End If
End Sub

Public Function SetDisplayMode(ByRef inMode As clsDisplayMode, Optional ByVal inTestOnly As Boolean) As enDisplayChangeResult
    If (inMode Is Nothing) Then Exit Function
    SetDisplayMode = ChangeDisplaySettingsEx(m_DisplayName, _
        DevInfFromMode(inMode), 0&, IIf(inTestOnly, CDS_TEST, CDS_FORCE), ByVal 0&) <> 0
End Function

Public Function MoveScreen(ByVal inX As Long, ByVal inY As Long, Optional ByVal inTestOnly As Boolean) As enDisplayChangeResult
    Dim ModeInf As DevMode
    
    ' Get a device information structure describing the current display mode, and append positional data
    ModeInf = DevInfFromMode(Me.CurrentDisplayMode())
    ModeInf.dmFields = ModeInf.dmFields Or DM_POSITION
    ModeInf.dmPosition.X = inX
    ModeInf.dmPosition.Y = inY
    
    MoveScreen = ChangeDisplaySettingsEx(m_DisplayName, ModeInf, 0&, IIf(inTestOnly, CDS_TEST, CDS_FORCE), ByVal 0&) <> 0
End Function

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
   Set NewEnum = m_DisplayModes.[_NewEnum]
End Function

Private Function DevInfFromMode(ByRef inMode As clsDisplayMode) As DevMode
    With DevInfFromMode
        .dmSize = Len(DevInfFromMode)
        .dmPelsWidth = inMode.Width
        .dmPelsHeight = inMode.Height
        .dmBitsPerPel = inMode.Depth
        .dmDisplayFrequency = inMode.Frequency
        .dmDisplayOrientation = inMode.DisplayOrientation
        .dmDisplayFixedOutput = inMode.DisplayFixedOutput
        .dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or _
            DM_DISPLAYFREQUENCY Or DM_DISPLAYORIENTATION Or DM_DISPLAYFIXEDOUTPUT
    End With
End Function

Private Function GetDisplayMode(ByVal inIdx As Long) As clsDisplayMode
    Dim DevInf As DevMode
    
    DevInf.dmSize = Len(DevInf) ' Retrieve the display settings for this specific mode
    DevInf.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or _
        DM_DISPLAYFREQUENCY Or DM_DISPLAYORIENTATION Or DM_DISPLAYFIXEDOUTPUT
    
    If (EnumDisplaySettingsEx(m_DisplayName, inIdx, DevInf, 0&) <> 0) Then
        Set GetDisplayMode = New clsDisplayMode
        
        With DevInf
            Call GetDisplayMode.Create(.dmPelsWidth, .dmPelsHeight, .dmBitsPerPel, _
                .dmDisplayFrequency, .dmDisplayOrientation, .dmDisplayFixedOutput)
        End With
    End If
End Function

Private Function RectFromUDT(ByRef inUDT As RectAPI) As clsRect
    Set RectFromUDT = New clsRect
    
    With RectFromUDT
        .Left = inUDT.Left
        .Top = inUDT.Top
        .Right = inUDT.Right
        .Bottom = inUDT.Bottom
    End With
End Function

Private Function TrimNull(ByVal inString As String) As String
    Dim NullPos As Long
    NullPos = InStr(1, inString, vbNullChar)
    If (NullPos) Then TrimNull = Left$(inString, NullPos - 1) Else TrimNull = inString
End Function

Private Sub ClearInfo()
    Dim LoopModes As Long
    
    m_DisplayName = ""
    m_DeviceString = ""
    m_DeviceID = ""
    m_DeviceKey = ""
    m_PrimaryDisplay = False
    m_AttachedToDesktop = False
    m_MirroringDriver = False
    m_VGACompatible = False
    m_Removable = False
    m_ModeSpruned = False
    
    Do While m_DisplayModes.Count
        Call m_DisplayModes.Remove(m_DisplayModes.Count())
    Loop
    
    Set m_WorkArea = Nothing
    Set m_Area = Nothing
End Sub

Private Sub Class_Initialize()
    Set m_DisplayModes = New Collection
End Sub

Private Sub Class_Terminate()
    Call ClearInfo
    Set m_DisplayModes = Nothing
End Sub