-
Notifications
You must be signed in to change notification settings - Fork 6
/
clsMonitors.cls
executable file
·128 lines (112 loc) · 3.38 KB
/
clsMonitors.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cMonitors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Option Compare Binary
Option Base 0
Private Type POINTAPI
x As Long
y As Long
End Type
Private Const SM_CXVIRTUALSCREEN = 78
Private Const SM_CYVIRTUALSCREEN = 79
Private Const SM_CMONITORS = 80
Private Const SM_SAMEDISPLAYFORMAT = 81
Private Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
Private Declare Function MonitorFromWindow Lib "User32" (ByVal hWND As Long, ByVal dwFlags As Long) As Long
Private Declare Function MonitorFromPoint Lib "User32" (pt As POINTAPI, ByVal dwFlags As Long) As Long
Private Const MONITOR_DEFAULTTONEAREST = 0
Private m_iCount As Long
Private m_cM() As cMonitor
Public Property Get AllMonitorsSame() As Long
AllMonitorsSame = GetSystemMetrics(SM_SAMEDISPLAYFORMAT)
End Property
Public Property Get MonitorForPoint(ByVal x As Long, ByVal y As Long) As cMonitor
Dim hMon As Long
Dim tP As POINTAPI
tP.x = x
tP.y = y
hMon = MonitorFromPoint(tP, MONITOR_DEFAULTTONEAREST)
If Not (hMon = 0) Then
Dim cM As cMonitor
Set cM = New cMonitor
cM.fInit hMon
Set MonitorForPoint = cM
End If
End Property
Public Property Get MonitorForWindow(ByVal hWND As Long) As cMonitor
Dim hMon As Long
hMon = MonitorFromWindow(hWND, MONITOR_DEFAULTTONEAREST)
If Not (hMon = 0) Then
Dim cM As cMonitor
Set cM = New cMonitor
cM.fInit hMon
Set MonitorForWindow = cM
End If
End Property
Public Property Get VirtualScreenLeft() As Long
Dim lRet As Long
Dim i As Long
lRet = m_cM(1).Left
For i = 2 To m_iCount
If (m_cM(i).Left < lRet) Then
lRet = m_cM(i).Left
End If
Next i
VirtualScreenLeft = lRet
End Property
Public Property Get VirtualScreenTop() As Long
Dim lRet As Long
Dim i As Long
lRet = m_cM(1).Top
For i = 2 To m_iCount
If (m_cM(i).Top < lRet) Then
lRet = m_cM(i).Top
End If
Next i
VirtualScreenTop = lRet
End Property
Public Property Get VirtualScreenWidth() As Long
VirtualScreenWidth = GetSystemMetrics(SM_CXVIRTUALSCREEN)
End Property
Public Property Get VirtualScreenHeight() As Long
VirtualScreenHeight = GetSystemMetrics(SM_CYVIRTUALSCREEN)
End Property
Public Property Get DisplayMonitorCount() As Long
DisplayMonitorCount = GetSystemMetrics(SM_CMONITORS)
End Property
Public Property Get MonitorCount() As Long
MonitorCount = m_iCount
End Property
Public Property Get Monitor(ByVal index As Long) As cMonitor
Set Monitor = m_cM(index)
End Property
Friend Sub fAddMonitor( _
ByVal hMonitor As Long _
)
' this sub will not actually provide an
' extra monitor to your system if it isn't
' already there. yet.
m_iCount = m_iCount + 1
ReDim Preserve m_cM(1 To m_iCount) As cMonitor
Set m_cM(m_iCount) = New cMonitor
m_cM(m_iCount).fInit hMonitor
End Sub
Public Sub Refresh()
m_iCount = 0
Erase m_cM
EnumMonitors Me
End Sub
Private Sub Class_Initialize()
Refresh
End Sub