- Option Explicit
-
- Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
- Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
- Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
- Private Type DEVMODE
- dmDeviceName As String * 32
- dmSpecVersion As Integer
- dmDriverVersion As Integer
- dmSize As Integer
- dmDriverExtra As Integer
- dmFields As Long
- dmOrientation As Integer
- dmPaperSize As Integer
- dmPaperLength As Integer
- dmPaperWidth As Integer
- dmScale As Integer
- dmCopies As Integer
- dmDefaultSource As Integer
- dmPrintQuality As Integer
- dmColor As Integer
- dmDuplex As Integer
- dmYResolution As Integer
- dmTTOption As Integer
- dmCollate As Integer
- dmFormName As String * 32
- dmUnusedPadding As Integer
- dmBitsPerPel As Integer
- dmPelsWidth As Long
- dmPelsHeight As Long
- dmDisplayFlags As Long
- dmDisplayFrequency As Long
- End Type
- Public Enum EnumSetRes
- SUCCES = 0
- ECHEC = -2
- End Enum
-
- Public Function GetNbCoul() As Integer
- Dim dmEcran As DEVMODE
- Dim blTMP As Boolean
- blTMP = EnumDisplaySettings(0, -1, dmEcran)
- GetNbCoul = dmEcran.dmBitsPerPel
- End Function
- Public Function GetResX() As Integer
- Dim dmEcran As DEVMODE
- EnumDisplaySettings 0, -1, dmEcran
- GetResX = dmEcran.dmPelsWidth
- ' GetResX = Screen.Width \ Screen.TwipsPerPixelX
- End Function
- Public Function GetResY() As Integer
- Dim dmEcran As DEVMODE
- EnumDisplaySettings 0, -1, dmEcran
- GetResY = dmEcran.dmPelsHeight
- ' GetResY = Screen.Height \ Screen.TwipsPerPixelY
- End Function
- Public Function SetRes(ByVal RezX As Single, ByVal RezY As Single, ByVal NbCoul As Integer) As EnumSetRes
- If RezX = GetResX And RezY = GetResY And NbCoul = GetNbCoul Then Exit Function
- Dim dmEcran As DEVMODE
- Dim blTMP As Boolean, lgTMP As Long
- blTMP = EnumDisplaySettings(0, -1, dmEcran)
- 'dmEcran.dmFields = 1835008
- If RezX <> GetResX Then dmEcran.dmFields = &H80000
- If RezY <> GetResY Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
- If NbCoul <> GetNbCoul Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
- dmEcran.dmPelsWidth = RezX
- dmEcran.dmPelsHeight = RezY
- dmEcran.dmBitsPerPel = NbCoul
- Call ChangeDisplaySettings(dmEcran, 1)
- blTMP = SendMessage(65535, 27, 0, 0)
- Dim ScInfo As Long
- ScInfo = RezY * 2 ^ 16 + RezX
- SendMessage &HFFFF&, &H7E, ByVal NbCoul, ByVal ScInfo
- SetRes = lgTMP
- End Function
Option Explicit
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Enum EnumSetRes
SUCCES = 0
ECHEC = -2
End Enum
Public Function GetNbCoul() As Integer
Dim dmEcran As DEVMODE
Dim blTMP As Boolean
blTMP = EnumDisplaySettings(0, -1, dmEcran)
GetNbCoul = dmEcran.dmBitsPerPel
End Function
Public Function GetResX() As Integer
Dim dmEcran As DEVMODE
EnumDisplaySettings 0, -1, dmEcran
GetResX = dmEcran.dmPelsWidth
' GetResX = Screen.Width \ Screen.TwipsPerPixelX
End Function
Public Function GetResY() As Integer
Dim dmEcran As DEVMODE
EnumDisplaySettings 0, -1, dmEcran
GetResY = dmEcran.dmPelsHeight
' GetResY = Screen.Height \ Screen.TwipsPerPixelY
End Function
Public Function SetRes(ByVal RezX As Single, ByVal RezY As Single, ByVal NbCoul As Integer) As EnumSetRes
If RezX = GetResX And RezY = GetResY And NbCoul = GetNbCoul Then Exit Function
Dim dmEcran As DEVMODE
Dim blTMP As Boolean, lgTMP As Long
blTMP = EnumDisplaySettings(0, -1, dmEcran)
'dmEcran.dmFields = 1835008
If RezX <> GetResX Then dmEcran.dmFields = &H80000
If RezY <> GetResY Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
If NbCoul <> GetNbCoul Then dmEcran.dmFields = dmEcran.dmFields Or &H100000
dmEcran.dmPelsWidth = RezX
dmEcran.dmPelsHeight = RezY
dmEcran.dmBitsPerPel = NbCoul
Call ChangeDisplaySettings(dmEcran, 1)
blTMP = SendMessage(65535, 27, 0, 0)
Dim ScInfo As Long
ScInfo = RezY * 2 ^ 16 + RezX
SendMessage &HFFFF&, &H7E, ByVal NbCoul, ByVal ScInfo
SetRes = lgTMP
End Function