Modifier la résolution de plusieurs écransRésolu

Question

Bonjour, J'ai récupérer le code suivant sur le site pour modifier la résolution d'un écran, mais comment l'adapter pour modifier l'affichage de 4 écrans que j'utilise pour mon application. Merci !

Option Explicit
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
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 * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_DISPLAYFLAGS = &H200000
Const DM_DISPLAYFREQUENCY = &H400000
Private Declare Function ChangeDisplaySettings Lib "user32" Alias
"ChangeDisplaySettingsA" (lpInitData As DEVMODE, ByVal dwFlags As Long)
As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias
"EnumDisplaySettingsA" (lpszDeviceName As Any, ByVal iModeNum As Long,
lpDevMode As Any) As Boolean
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As
Long, ByVal dwReserved As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long,
ByVal nIndex As Long) As Long
Const BITSPIXEL = 12
Dim D As DEVMODE
dim lBits As Long, Largeurecran As Double, Hauteurecran As Double
'*************écrire ce code dans "Form_Activate"**************
Private Sub Form_Activate()
lBits = GetDeviceCaps(hdc, BITSPIXEL)
Largeur = Screen.Width \ Screen.TwipsPerPixelX
Hauteur = Screen.Height \ Screen.TwipsPerPixelY
Call EnumDisplaySettings(0&, -1, D)
D.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
D.dmPelsWidth = 1024 'vous pouvez spécifier la résolution désirée
D.dmPelsHeight = 768 'vous pouvez spécifier la résolution désirée
D.dmBitsPerPel = 32
Call ChangeDisplaySettings(D, 1)
End Sub
'********écrire ce code dans "Form_Terminate"***********************
Private Sub Form_Terminate()
Dim res As DEVMODE
Call EnumDisplaySettings(0&, -1, res)
res.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
res.dmPelsWidth = Largeur
res.dmPelsHeight = Hauteur
res.dmBitsPerPel = lBits
Call ChangeDisplaySettings(res, 1)
End Sub

Daghis · Accepted Answer

On est jamais mieux servi que par soi-méme

Une Soixantaine d'internautes est venu lire mon problème et personne n'a su y répondre???

Bref moi j'ai cherché et j'ai écris ça.

Ca marche pour moi.

Je vous le transmets au cas où ça interesserait quelqu'un

'------------------------------------------------------
Option Explicit


Private Declare Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" (lpszDeviceName As Any, lpDevMode As Any, ByVal hWnd As Long, ByVal dwFlags 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
    dmICMMethod As Long 'NT 4.0
End Type


Dim NRame As Byte
Dim DLL_COS As Object
Dim Machine(2) As Object
Dim Wagon(8) As Object
Dim Rame2Côtés As Object
Dim Câblot As Object
Dim Côté As String


Private Sub Main()
Dim J As Byte


' *********************************************************************************
' Ces lignes pour modifier la résolution vidéo
Dim DevM As DEVMODE
DevM.dmSize = Len(DevM)
DevM.dmFields = &H80000 Or &H100000
DevM.dmPelsWidth = 1280
DevM.dmPelsHeight = 1024


Call ChangeDisplaySettingsEx(ByVal "[file://\.\DISPLAY1 \.\DISPLAY1]", DevM, ByVal 0&, &H4, ByVal 0&)
Call ChangeDisplaySettingsEx(ByVal "[file://\.\DISPLAY2 \.\DISPLAY2]", DevM, ByVal 0&, &H4, ByVal 0&)
Call ChangeDisplaySettingsEx(ByVal "[file://\.\DISPLAY3 \.\DISPLAY3]", DevM, ByVal 0&, &H4, ByVal 0&)
Call ChangeDisplaySettingsEx(ByVal "[file://\.\DISPLAY4 \.\DISPLAY4]", DevM, ByVal 0&, &H4, ByVal 0&)
' *********************************************************************************

Modifier la résolution de plusieurs écrans

1 réponse

Votre réponse

Discussions similaires