Работа с библиотекой Dxva2.dll
На англоязычном форуме: https://www.vbforums.com/showt... tor-handle
Пользователь Eduardo предложил решение получения информации о мониторе, используя функции библиотеки "Dxva2.dll". Основная проблема в получении хэндла монитора. Всё оказалось вполне решаемым средствами VB 6.0.
Вот текст предложенного модуля:
| Visual Basic | 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
129
130
131
132
133
134
135
136
137
138
139
140
| Option Explicit
Private Type LPPHYSICAL_MONITOR
hPhysicalMonitor As Long
szPhysicalMonitorDescription(127) As Integer
End Type
Private Declare Function EnumDisplayMonitors Lib "user32.dll" (ByVal hdc As Long, ByRef lprcClip As Any, ByVal lpfnEnum As Long, ByVal dwData As Long) As Boolean
Private Declare Function GetMonitorInfo Lib "user32.dll" Alias "GetMonitorInfoA" (ByVal hMonitor As Long, ByRef lpmi As MONITORINFOEX) As Boolean
Private Declare Function GetPhysicalMonitorsFromHMONITOR Lib "Dxva2.dll" (ByVal hMonitor As Long, ByVal dwPhysicalMonitorArraySize As Long, ByRef pPhysicalMonitorArray As Any) As Long
Private Declare Function GetNumberOfPhysicalMonitorsFromHMONITOR Lib "Dxva2.dll" (ByVal hMonitor As Long, ByRef pdwNumberOfPhysicalMonitors As Long) As Long
Private Declare Function CapabilitiesRequestAndCapabilitiesReply Lib "Dxva2.dll" (ByVal hMonitor As Long, ByRef pszASCIICapabilitiesString As Any, ByVal dwCapabilitiesStringLengthInCharacters As Long) As Long
Private Declare Function GetCapabilitiesStringLength Lib "Dxva2.dll" (ByVal hMonitor As Long, ByRef pdwCapabilitiesStringLengthInCharacters As Long) As Long
Private Declare Function DestroyPhysicalMonitors Lib "Dxva2.dll" (ByVal dwPhysicalMonitorArraySize As Long, ByRef pPhysicalMonitorArray As Any) As Long
Private Declare Function GetMonitorBrightness Lib "Dxva2.dll" (ByVal hPhMonitor As Long, ByRef min As Long, ByRef cur As Long, ByRef max As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbSizeBytes As Long)
Private Const PHYSICAL_MONITOR_DESCRIPTION_SIZE As Long = 128
Private Const CCHDEVICENAME = 32
Private Const MONITORINFOF_PRIMARY = &H1
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type MONITORINFOEX
cbSize As Long
rcMonitor As RECT
rcWork As RECT
dwFlags As Long
szDevice As String * CCHDEVICENAME
End Type
Public Function GetMonitorsInfo()
Call EnumDisplayMonitors(0&, ByVal 0&, AddressOf MonitorEnumProc, 0&)
End Function
Private Function MonitorEnumProc(ByVal hMonitor As Long, ByVal hdcMonitor As Long, ByRef lprcMonitor As RECT, ByVal dwData As Long) As Boolean
MsgBox GetMonitorInformation(hMonitor)
Debug.Print GetMonitorInformation(hMonitor)
MonitorEnumProc = 1
End Function
Private Function GetMonitorInformation(hMonitor As Long) As String
Dim iMONITORINFOEX As MONITORINFOEX
Dim iRet As String
Dim iPM() As LPPHYSICAL_MONITOR
Dim iCount As Long
Dim c As Long
Dim iLenght As Long
Dim iMonitorDataStr As String
Dim iStr As String
Dim iBrMin As Long
Dim iBrMax As Long
Dim iBrCurrent As Long
iMONITORINFOEX.cbSize = Len(iMONITORINFOEX)
If GetMonitorInfo(hMonitor, iMONITORINFOEX) <> 0 Then
If GetNumberOfPhysicalMonitorsFromHMONITOR(hMonitor, iCount) <> 0 Then
ReDim iPM(iCount - 1)
If GetPhysicalMonitorsFromHMONITOR(hMonitor, iCount, iPM(0)) <> 0 Then
For c = 0 To iCount - 1
If GetCapabilitiesStringLength(iPM(c).hPhysicalMonitor, iLenght) <> 0 Then
ReDim iBytes(iLenght - 1) As Byte
If CapabilitiesRequestAndCapabilitiesReply(iPM(c).hPhysicalMonitor, iBytes(0), iLenght) <> 0 Then
iMonitorDataStr = StrConv(iBytes, vbUnicode)
iMonitorDataStr = Left(iMonitorDataStr, Len(iMonitorDataStr) - 1)
iRet = iRet & "Model: " & GetMonitorModelFromData(iMonitorDataStr) & vbCrLf
iRet = iRet & "Type: " & GetMonitorTypeFromData(iMonitorDataStr) & vbCrLf
End If
End If
iStr = Space$(128)
CopyMemory ByVal StrPtr(iStr), iPM(c).szPhysicalMonitorDescription(0), 256
iLenght = InStr(iStr, Chr(0))
iStr = Left$(iStr, iLenght - 1)
iRet = iRet & "Description: " & iStr & vbCrLf
If GetMonitorBrightness(iPM(c).hPhysicalMonitor, iBrMin, iBrCurrent, iBrMax) Then
iRet = iRet & "Brightnes: from " & iBrMin & " to " & iBrMax & ", current is " & iBrCurrent & vbCrLf
End If
Next c
Call DestroyPhysicalMonitors(iCount, iPM(0))
End If
End If
With iMONITORINFOEX
iStr = CStr(.szDevice)
iLenght = InStr(iStr, Chr(0))
iStr = Left$(iStr, iLenght - 1)
iRet = iRet & "Device: " & iStr & vbCrLf
iRet = iRet & "Primary: " & IIf(.dwFlags And MONITORINFOF_PRIMARY, "Yes", "No") & vbCrLf
With .rcMonitor
iRet = iRet & "Monitor Left : " & .Left & vbCrLf
iRet = iRet & "Monitor Top : " & .Top & vbCrLf
iRet = iRet & "Monitor Right : " & .Right & vbCrLf
iRet = iRet & "Monitor Bottom : " & .Bottom & vbCrLf
End With
With .rcWork
iRet = iRet & "Work area Left : " & .Left & vbCrLf
iRet = iRet & "Work area Top : " & .Top & vbCrLf
iRet = iRet & "Work area Right : " & .Right & vbCrLf
iRet = iRet & "Work area Bottom : " & .Bottom & vbCrLf
End With
End With
End If
GetMonitorInformation = iRet
End Function
Private Function GetMonitorModelFromData(ByVal nMonitorData As String) As String
Dim iPos1 As Long
Dim iPos2 As Long
nMonitorData = LCase(nMonitorData)
iPos1 = InStr(nMonitorData, "model(")
If iPos1 > 0 Then
iPos2 = InStr(iPos1 + 1, nMonitorData, ")")
If iPos2 > 0 Then
GetMonitorModelFromData = Mid$(nMonitorData, iPos1 + 6, iPos2 - iPos1 - 6)
GetMonitorModelFromData = UCase$(GetMonitorModelFromData)
End If
End If
End Function
Private Function GetMonitorTypeFromData(ByVal nMonitorData As String) As String
Dim iPos1 As Long
Dim iPos2 As Long
nMonitorData = LCase(nMonitorData)
iPos1 = InStr(nMonitorData, "type(")
If iPos1 > 0 Then
iPos2 = InStr(iPos1 + 1, nMonitorData, ")")
If iPos2 > 0 Then
GetMonitorTypeFromData = Mid$(nMonitorData, iPos1 + 5, iPos2 - iPos1 - 5)
GetMonitorTypeFromData = UCase$(GetMonitorTypeFromData)
End If
End If
End Function |
|
Вызов из кода формы:
| Visual Basic | 1
2
3
| Private Sub Command1_Click()
GetMonitorsInfo
End Sub |
|
| Code | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
| Model: PHILIPS 244E1
Type: LCD
Description: Универсальный монитор PnP
Brightnes: from 0 to 100, current is 72
Device: \\.\DISPLAY1
Primary: Yes
Monitor Left : 0
Monitor Top : 0
Monitor Right : 1920
Monitor Bottom : 1080
Work area Left : 0
Work area Top : 0
Work area Right : 1920
Work area Bottom : 1032 |
|
Сначала объявления без переменных:
| Visual Basic | 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
| Option Explicit
Const MONITOR_DEFAULTTONEAREST = &H2
Private Type LPPHYSICAL_MONITOR
hPhysicalMonitor As Long
szPhysicalMonitorDescription(127) As Byte
End Type
'Именованные константы, но можно и без них. Просто подставляя в функцию числовые значения.
Private Enum MC_GAIN_TYPE
MC_RED_GAIN = 0
MC_GREEN_GAIN = 1
MC_BLUE_GAIN = 2
End Enum
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetPhysicalMonitorsFromHMONITOR Lib "Dxva2.dll" (ByVal hMonitor As Long, _
ByVal dwPhysicalMonitorArraySize As Long, ByRef pPhysicalMonitorArray As Any) As Long
Private Declare Function GetNumberOfPhysicalMonitorsFromHMONITOR Lib "Dxva2.dll" (ByVal hMonitor As Long, _
ByRef pdwNumberOfPhysicalMonitors As Long) As Long
Private Declare Function GetMonitorBrightness Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByRef min As Long, ByRef cur As Long, ByRef max As Long) As Boolean
Private Declare Function SetMonitorBrightness Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByVal dwNewBrightness As Long) As Boolean
Private Declare Function DestroyPhysicalMonitors Lib "Dxva2.dll" (ByVal dwPhysicalMonitorArraySize As Long, _
ByRef pPhysicalMonitorArray As Any) As Long
Private Declare Function GetMonitorContrast Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByRef pdwMinimumContrast As Long, ByRef pdwCurrentContrast As Long, _
ByRef pdwMaximumContrast As Long) As Boolean
Private Declare Function SetMonitorContrast Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByVal dwNewContrast As Long) As Boolean
Private Declare Function GetMonitorRedGreenOrBlueGain Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByVal gtGain As MC_GAIN_TYPE, ByRef pdwMinimumGain As Long, ByRef pdwCurrentGain As Long, _
ByRef pdwMaximumGain As Long) As Boolean
Private Declare Function SetMonitorRedGreenOrBlueGain Lib "Dxva2.dll" (ByVal hPhMonitor As Long, _
ByVal gtGain As MC_GAIN_TYPE, ByVal dwNewGain As Long) As Boolean |
|
| Visual Basic | 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
| Dim hDesktop As Long
Dim hMonitor As Long
Dim hPhMonitor As Long
Dim iPM() As LPPHYSICAL_MONITOR
hDesktop = GetDesktopWindow()
hMonitor = MonitorFromWindow(hDesktop, MONITOR_DEFAULTTONEAREST)
If GetNumberOfPhysicalMonitorsFromHMONITOR(hMonitor, iCount) <> 0 Then
ReDim iPM(iCount - 1)
If GetPhysicalMonitorsFromHMONITOR(hMonitor, iCount, iPM(0)) <> 0 Then
hPhMonitor = iPM(0).hPhysicalMonitor 'Получаем хэндл монитора
If GetMonitorBrightness(hPhMonitor, min, cur, max) Then 'Получаем значение яркости в переменные типа Long
Debug.Print min, cur, max
End If
If GetMonitorContrast(hPhMonitor, conmin, concur, conmax) Then 'Получаем значение контрастности в переменные типа Long
Debug.Print conmin, concur, conmax
End If
'Получаем значение уровня красного цвета в переменные типа Long
If GetMonitorRedGreenOrBlueGain(hPhMonitor, MC_RED_GAIN, satmin, satcur, satmax) Then
Debug.Print satmin, satcur, satmax
End If
'По аналогии подставляем константы зелёного и синего цветов.
'Для изменения их уровня использовать функцию:
SetMonitorRedGreenOrBlueGain(hPhMonitor, MC_RED_GAIN, NewGain)
End If
End If |
|
Иногда появляется необходимость изменить яркость и контрастность монитора. Особенно, в случае резкого изменения яркости внешнего освещения.
Делать это с помощью кнопок или настроек рабочего стола неудобно.
При старте программа запоминает значения яркости и контрастности.
Пользователь может изменять настройки с помощью слайдеров.
Перед выходом, программа восстанавливает начальные значения.
|
dxva2.dll - private интерфейс?
Яркость- контрастность это хорошо, но скажем так, можно и встроенными органами управления на мониторе регулировать.
