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 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
|
'1/fichier Display.vb
Imports System.Runtime.InteropServices
' Encapsulates access to the PInvoke functions
Public Class Display
' Return a list of all possible display types for this computer
Public Function GetDisplaySettings() As List(Of DevMode)
Dim modes As New List(Of DevMode)
Dim devmode As DevMode = Me.DevMode
Dim counter As Integer = 0
Dim returnValue As Integer = 1
' A return value of zero indicates that no more settings are available
While returnValue <> 0
returnValue = GetSettings(devmode, counter)
modes.Add(devmode)
counter = counter + 1
End While
Return modes
End Function
' Return the current display setting
Public Function GetCurrentSettings(ByRef dm As DevMode) As Integer
' helper to obtain current settings
Return GetSettings(dm, NativeMethods.ENUM_CURRENT_SETTINGS)
End Function
' Change the settings to the values of the DEVMODE passed
Public Function ChangeSettings(ByVal devmode As DevMode) As String
Dim errorMessage As String = ""
Dim iRet As ReturnCodes = NativeMethods.ChangeDisplaySettings(devmode, 0)
Select Case iRet
Case ReturnCodes.DISP_CHANGE_SUCCESSFUL
Exit Function
Case ReturnCodes.DISP_CHANGE_RESTART
' TODO: Raise System Restart Required Event
errorMessage = "Please restart your system"
Exit Function
Case ReturnCodes.DISP_CHANGE_FAILED
errorMessage = "ChangeDisplaySettigns API failed"
Exit Function
Case ReturnCodes.DISP_CHANGE_BADDUALVIEW
errorMessage = "The settings change was unsuccessful because system is DualView capable."
Exit Function
Case ReturnCodes.DISP_CHANGE_BADFLAGS
errorMessage = "An invalid set of flags was passed in."
Exit Function
Case ReturnCodes.DISP_CHANGE_BADPARAM
errorMessage = "An invalid parameter was passed in. This can include an invalid flag or combination of flags."
Exit Function
Case ReturnCodes.DISP_CHANGE_NOTUPDATED
errorMessage = "Unable to write settings to the registry."
Exit Function
Case Else
errorMessage = "Unknown return value from ChangeDisplaySettings API"
Exit Function
End Select
Return errorMessage
End Function
' Return a properly configured DEVMODE
Public ReadOnly Property DevMode() As DevMode
Get
Dim m_devmode As DevMode = New DevMode()
m_devmode.dmDeviceName = New String(New Char(), 32)
m_devmode.dmFormName = New String(New Char(), 32)
m_devmode.dmSize = CType(Marshal.SizeOf(DevMode), Short)
Return m_devmode
End Get
End Property
' call the external function inthe Win32 API
Private Function GetSettings(ByRef dm As DevMode, ByRef iModeNum As Integer) As Integer
' helper to wrap EnumDisplaySettings Win32 API
Return NativeMethods.EnumDisplaySettings(Nothing, iModeNum, dm)
End Function
End Class
'2/fichier NativeMethods.vb
Imports System.Runtime.InteropServices
' Encapsulate the magic numbers for the return value in an enumeration
Public Enum ReturnCodes As Integer
DISP_CHANGE_SUCCESSFUL = 0
DISP_CHANGE_BADDUALVIEW = -6
DISP_CHANGE_BADFLAGS = -4
DISP_CHANGE_BADMODE = -2
DISP_CHANGE_BADPARAM = -5
DISP_CHANGE_FAILED = -1
DISP_CHANGE_NOTUPDATED = -3
DISP_CHANGE_RESTART = 1
End Enum
' To see how the DEVMODE struct was translated from the unmanaged to the managed see the Task 2 Declarations section
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_8nle.asp
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Public Structure DevMode
' The MarshallAs attribute is covered in the Background section of the article
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
Public dmDeviceName As String
Public dmSpecVersion As Short
Public dmDriverVersion As Short
Public dmSize As Short
Public dmDriverExtra As Short
Public dmFields As Integer
Public dmPositionX As Integer
Public dmPositionY As Integer
Public dmDisplayOrientation As Integer
Public dmDisplayFixedOutput As Integer
Public dmColor As Short
Public dmDuplex As Short
Public dmYResolution As Short
Public dmTTOption As Short
Public dmCollate As Short
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
Public dmFormName As String
Public dmLogPixels As Short
Public dmBitsPerPel As Short
Public dmPelsWidth As Integer
Public dmPelsHeight As Integer
Public dmDisplayFlags As Integer
Public dmDisplayFrequency As Integer
Public dmICMMethod As Integer
Public dmICMIntent As Integer
Public dmMediaType As Integer
Public dmDitherType As Integer
Public dmReserved1 As Integer
Public dmReserved2 As Integer
Public dmPanningWidth As Integer
Public dmPanningHeight As Integer
Public Overrides Function ToString() As String
Return dmPelsWidth.ToString() + " x " + dmPelsHeight.ToString()
End Function
Public Function GetInfoArray() As String()
Dim items() As String = New String(5) {}
items(0) = dmDeviceName
items(1) = dmPelsWidth.ToString()
items(2) = dmPelsHeight.ToString()
items(3) = dmDisplayFrequency.ToString()
items(4) = dmBitsPerPel.ToString()
Return items
End Function
End Structure
Public Class NativeMethods
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/devcons_84oj.asp
<DllImport("user32.dll", CharSet:=CharSet.Ansi)> _
Public Shared Function EnumDisplaySettings(ByVal lpszDeviceName As String, ByVal iModeNum As Integer, ByRef lpDevMode As DevMode) As Integer
End Function
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/devcons_7gz7.asp
<DllImport("user32.dll", CharSet:=CharSet.Ansi)> _
Public Shared Function ChangeDisplaySettings(ByRef lpDevMode As DevMode, ByVal dwFlags As Integer) As ReturnCodes
End Function
Public Const ENUM_CURRENT_SETTINGS As Integer = -1
End Class |
Partager