Trucos Cambiar la resolución de la pantalla

Declaramos en el formulario :

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

  Const CCDEVICENAME = 32
  Const CCFORMNAME = 32
  Const DM_PELSWIDTH = &H80000
  Const DM_PELSHEIGHT = &H100000

  Private Type DEVMODE
        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 '20
        dmUnusedPadding As Integer
        dmBitsPerPel As Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
  End Type

  Dim DevM As DEVMODE

Y creamos la función :

Function CambiaResolucion(BitPorPixel As Integer, Ancho As Integer, Alto As Integer) As Boolean
    'Función para cambiar la resolución de la pantalla en W95
    'Parámetros :
    'BitPorPixel : Nº de bits de color
    ' 4 - 16 colores, 8 - 256 colores
    ' 16 - 65.000 colores, 32 - 16 M de colores
    'Ancho : Nº de pixels de ancho
    'Alto : Nº de pixels de alto

    Dim a&
    a = EnumDisplaySettings(0&, 0&, DevM)
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmBitsPerPel = BitPorPixel
    DevM.dmPelsWidth = Ancho
    DevM.dmPelsHeight = Alto
    a = ChangeDisplaySettings(DevM, 0)
    If a = 0 Then
        CambiaResolucion = True
    Else
        CambiaResolucion = False
    End If
End Function

Para cambiar la resolución simplemente llamamos a la función CambiaResolución con los parámetros deseados y nos devolverá si pudo o no hacer el cambio.

Este código está basado en un ejemplo de ViVaLDi (amanuelx@hotmail.com)

Nota:

Realmente esta función, tal como está, no funciona correctamente si se intenta cambiar el número de colores.

En ese caso la función ChangeDisplaySettings devuelve 1 (uno), con lo que CambiarResolucion devuelve 0 (cero). En realidad esto no es que no se haya podido cambiar sino que debemos reiniciar el ordenador para que los cambios tengan efecto.



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com