Cambiar la resolución de pantalla - revisado para Win XP

Código de la clase ScrChanges.cls

    ' Declaración de Funciones API a usar
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
    (lpDevMode As Any, ByVal dwFlags As Long) As Long

    ' API para saber los formatos de resoluciones posibles
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
    (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
    lpDevMode As DEVMODE) As Boolean

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

    Const CCHDEVICENAME = 32
    Const CCHFORMNAME = 32

    Const DM_BITSPERPEL = &H40000
    Const DM_PELSWIDTH = &H80000
    Const DM_PELSHEIGHT = &H100000
    Const DM_DISPLAYFLAGS = &H200000
    Const DM_DISPLAYFREQUENCY = &H400000

    Const BITSPIXEL = 12

    ' Flags para cambiar resoluciones
    Const CDS_UPDATEREGISTRY = &H1
    Const CDS_TEST = &H2
    Const CDS_FULLSCREEN = &H4
    Const CDS_GLOBAL = &H8
    Const CDS_SET_PRIMARY = &H10
    Const CDS_RESET = &H40000000
    Const CDS_SETRECT = &H20000000
    Const CDS_NORESET = &H10000000

    ' Valores retornados por ChangeDisplaySettings
    Const DISP_CHANGE_SUCCESSFUL = 0
    Const DISP_CHANGE_RESTART = 1
    Const DISP_CHANGE_FAILED = -1
    Const DISP_CHANGE_BADMODE = -2
    Const DISP_CHANGE_NOTUPDATED = -3
    Const DISP_CHANGE_BADFLAGS = -4
    Const DISP_CHANGE_BADPARAM = -5

    ' Valores usados en EnumDisplaySettings
    Const ENUM_CURRENT_SETTINGS As Long = -1&
    Const ENUM_REGISTRY_SETTINGS As Long = -2&

    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

    ' Matriz para guardar los formatos disponibles
    Dim ScrMode() As DEVMODE
    Dim NumModes As Long
    ' Variables para guardar la configuración actual
    Dim lBits As Long, lWidth As Long, lHeight As Long, IndexSM As Long





    Private Flg As Boolean




    Public Sub Init(hdcFrm As Long)
        ' Se debe pasar el Hdc del Form que llama a la clase
        ' Tomamos la configuración inicial del video
        Dim hdc As Long
        hdc = hdcFrm

        lBits = GetDeviceCaps(hdc, BITSPIXEL)
        lWidth = Screen.Width \ Screen.TwipsPerPixelX
        lHeight = Screen.Height \ Screen.TwipsPerPixelY


        ' Cargamos los posibles modos
        Dim i As Long
        Dim a As Long
        Dim s As String

        ReDim Preserve ScrMode(0) As DEVMODE

        i = 0
        Do
            a = EnumDisplaySettings(0&, i, ScrMode(i))
            i = i + 1
            If a Then
                ReDim Preserve ScrMode(i) As DEVMODE
                If lBits = ScrMode(i - 1).dmBitsPerPel And _
                lWidth = ScrMode(i - 1).dmPelsWidth And _
                lHeight = ScrMode(i - 1).dmPelsHeight Then
                IndexSM = i - 1
            End If
        End If
    Loop While a
    NumModes = i - 1
    Flg = True
End Sub



Public Sub LoadModes(SMode() As String)
    If Flg = False Then Exit Sub
    ' Carga en una matriz los modos disponibles
    Dim x As Long
    ReDim SMode(0 To NumModes) As String
    For x = 0 To NumModes
        SMode(x) = Format$(ScrMode(x).dmPelsWidth, " @@@@") & " x " & _
        Format$(ScrMode(x).dmPelsHeight, "@@@@") & " " & _
        Format$(ScrMode(x).dmBitsPerPel, "@@") & " bits"
    Next x

End Sub


Public Function ChangeMode(Index As Long) As Long
    'Cambia la resolución de acuerdo a la posición de la matriz pasada en Index
    If Flg = False Then Exit Function
    Dim Cdv As Long

    If Index < 0 Or Index > NumModes Then
        ChangeMode = 255
        Exit Function
    End If

    ScrMode(Index).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
    Flags = CDS_UPDATEREGISTRY
    Cdv = ChangeDisplaySettings(ScrMode(Index), Flags)
    ChangeMode = Cdv

    ' Valores devueltos en ChangeMode
    ' 0  = Cambio realizado
    ' 1  = Debe reiniciar para ver los cambios
    ' -1 = Error al realizar el cambio

End Function


Public Function RestoreInicial() As Long
    ' Restaura la resolución, dejando la configuración original cuando se creó la clase
    If Flg = False Then Exit Function
    RestoreInicial = ChangeMode(IndexSM)

End Function



Public Sub ModeInit(SAncho As Long, SAlto As Long, bits As Long, PosArray As Long)
    ' Devuelve las medidas del video inicial
    If Flg = False Then Exit Sub
    SAncho = ScrMode(IndexSM).dmPelsWidth
    SAlto = ScrMode(IndexSM).dmPelsHeight
    bits = ScrMode(IndexSM).dmBitsPerPel
    PosArray = IndexSM

End Sub

‘Acá termina el código de la clase

‘Esto es una base de cómo se puede usar en un formulario

En un formulario agregar una ListBox (List1) y 2 botones (Command1 y Command2)

Private ScrCls As New ScrChanges



                Private Sub Command1_Click()
                    Dim psi As Long
                    psi = List1.ListIndex
                    ScrCls.ChangeMode psi

                End Sub

                Private Sub Command2_Click()
                    ScrCls.RestoreInicial
                End Sub

                Private Sub Form_Load()
                    'cargamos la lista
                    ScrCls.Init Me.hdc
                    Dim sm() As String, x As Long
                    ScrCls.LoadModes sm()

                    For x = 0 To UBound(sm)
                        List1.AddItem sm(x)
                    Next x

                    ScrCls.ModeInit 0, 0, 0, psi&
                    List1.ListIndex = psi&

                End Sub

                Private Sub Form_Unload(Cancel As Integer)
                    'Restauramos la resolución inicial, esto es una prueba
                    ScrCls.RestoreInicial
                    'destruimos la clase
                    Set ScrCls = Nothing

                    End Sub

‘El código es básico, lo que recomiendo es no modificar la matriz donde se guardan los datos sobre las resoluciones soportadas, ya que en Windows XP es necesaria toda la información que se recibe en DevMode para realizar los cambios