Форум программистов, компьютерный форум, киберфорум
Argus19
Войти
Регистрация
Восстановить пароль
Оценить эту запись

Работа с библиотекой Dxva2.dll

Запись от Argus19 размещена 09.07.2021 в 22:24

Работа с библиотекой 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
Результат работы для моего монитора:
Код:
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
Кроме этого, можно получить и изменить значения контрастности и цветности. Но только R,G или В по-отдельности.
Сначала объявления без переменных:
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
В связи с тем, что доверять пользователю "играть" с балансом цветов несколько рискованно, сделал только регулировку яркости и контрастности.
Иногда появляется необходимость изменить яркость и контрастность монитора. Особенно, в случае резкого изменения яркости внешнего освещения.
Делать это с помощью кнопок или настроек рабочего стола неудобно.
При старте программа запоминает значения яркости и контрастности.
Пользователь может изменять настройки с помощью слайдеров.
Перед выходом, программа восстанавливает начальные значения.
Вложения
Тип файла: zip MonitorBrightness+Contrast.zip (5.8 Кб, 110 просмотров)
Размещено в Без категории
Показов 619 Комментарии 2
Всего комментариев 2
Комментарии
  1. Старый комментарий
    dxva2.dll - private интерфейс?
    Запись от IDK размещена Сегодня в 07:06 IDK вне форума
  2. Старый комментарий
    Аватар для Pro_grammer
    Яркость- контрастность это хорошо, но скажем так, можно и встроенными органами управления на мониторе регулировать.
    Есть в этой библиотеке другая замечательная функция - SetVCPFeature
    Она кроме всего прочего умеет выключать монитор, который поддерживает VESA Monitor Control Command Set. Причем выключать физически, как будто кнопкой. Это очень полезно, если вы это делаете дистанционно и программно.
    Запись от Pro_grammer размещена Сегодня в 10:36 Pro_grammer вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.