Sauvegarde / restauration / modification de la résolution d'écrans en dualscreen, trialscreen, etc...

Commenter

Contenu du snippet

Depuis windows 98, il est possible d'installer plus d'un moniteur sur son PC, on parle alors de dualscreen (pour 2 ecrans), trialscreen (pour trois), etc... Et ce jusqu'a 8, la limite de gestion de windows.

Le source suivant, permet de sauvegarder et restaure la résolutions de tous les écrans disponibles sur votre machine. (Fonctions SaveScreenResolution et RestoreScreenResolution ). Et de modifier la résolution de l'écran de votre choix (fonction SetScreenResolution )

La modification du nombre de couleurs n'est pas implémentée, les écrans gardent le nombre de couleurs tel que définie par le système.

Source / Exemple : 


Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32

Public Const DISPLAY_DEVICE_ATTACHED_TO_DESKTOP = &H1

Public DevMode() As TDEVMODE
Public DisplayDevice() As TDISPLAY_DEVICE

Public Type TDISPLAY_DEVICE
    cb As Long
    DeviceName As String * 32
    DeviceString As String * 128
    StateFlags As Long
    DeviceID As String * 128
    DeviceKey  As String * 128
End Type

Public Type TDEVMODE
    dmDeviceName As String * CCDEVICENAME
    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 * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long 'NT 4.0
    dmICMIntent As Long 'NT 4.0
    dmMediaType As Long 'NT 4.0
    dmDitherType As Long 'NT 4.0
    dmReserved1 As Long 'NT 4.0
    dmReserved2 As Long 'NT 4.0
    dmPanningWidth As Long 'Win2000
    dmPanningHeight As Long 'Win2000
End Type

Public Declare Function EnumDisplayDevices Lib "user32" Alias "EnumDisplayDevicesA" (Unused As Any, ByVal iDevNum As Long, lpDisplayDevice As TDISPLAY_DEVICE, ByVal dwFlags As Long) As Boolean
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As TDEVMODE) As Long
Public 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

' Save initial resolution for all screen device
Public Sub SaveScreenResolution()
    Dim DD As TDISPLAY_DEVICE
    Dim i As Integer
    i = 0
    Do
        DD.cb = Len(DD)
        EnumDisplayDevices ByVal 0&, i, DD, ByVal 0&
        If DD.StateFlags And DISPLAY_DEVICE_ATTACHED_TO_DESKTOP Then
            ReDim Preserve DisplayDevice(i)
            CopyMemory DisplayDevice(i), DD, Len(DD)
            ReDim Preserve DevMode(i)
            EnumDisplaySettings DisplayDevice(i).DeviceName, ENUM_CURRENT_SETTINGS, DevMode(i)
        End If
        If DD.StateFlags = 0 Then Exit Do
        i = i + 1
    Loop
End Sub

' Restore initial resolution for all screen device
Public Sub RestoreScreenResolution()
    Dim i As Integer
    For i = 0 To UBound(DevMode)
        DevMode(i).dmSize = Len(DevMode(0))
        DevMode(i).dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
        Call ChangeDisplaySettingsEx(ByVal DisplayDevice(i).DeviceName, DevMode(i), ByVal 0&, ByVal 0&, ByVal 0&)
    Next i
End Sub

' Toggle screenNumber as selected resolution
Public Function SetScreenResolution(screenNumber As Integer, width As Integer, height As Integer) As Boolean
    Dim DevM As TDEVMODE
    Dim ret As Long
    
    SetScreenResolution = False
    DevM.dmSize = Len(DevM)
    CopyMemory DevM, DevMode(screenNumber), Len(DevM)
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = width
    DevM.dmPelsHeight = height
    If ChangeDisplaySettingsEx(ByVal DisplayDevice(screenNumber).DeviceName, DevM, ByVal 0&, ByVal 0&, ByVal 0&) = DISP_CHANGE_SUCCESSFUL Then SetScreenResolution = True
End Function

Conclusion :


Testé sous Win 2000.
Fonctionne normalement sous Win98 et XP, mais pas encore testé.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (chnickel)