Aquí tienes tres cosillas relacionadas con la resolución de la pantalla usando el API de Windows.
- Averiguar la resolución actual y número de
colores, usando API.
- Cambiar/restaurar la resolución de forma
rápida.
- Enumerar las resoluciones disponibles y
cambiar/restaurar la resolución de la pantalla.
Si quieres bajarte el código de ejemplo, usa este link.
cambiarres2.zip (6.72 KB)
Nota:
He probado el código en Windows XP y no funciona, al menos no cambia la resolución.
Aunque si que muestra la resolución actual, así como el número de colores.
También muestra todos los valores disponibles, antes te comenté que no lo hacía
y era porque hice la prueba desde un "terminal" y no desde el equipo en el que
está instalado el XP, y ¡al estar el equipo conectado al Windows XP sólo trabaja
con una resolución!
Al final de la página te muestro la imagen del formulario funcionando en el
Windows XP.
He estado mirando el Platform SDK a ver si dice algo al respecto, pero no he
encontrado nada especial.
Lo único que he encontrado al revisar la documentación de estas funciones es que
hay que asignar a DevM.dmSize con el tamaño de la variable: DevM.dmSize =
Len(DevM)
En fin, si me entero de algo nuevo...
He cambiado el contenido del fichero ZIP, pero puede que el mostrado en esta página no tenga esa asignación que acabo de comentarte: DevM.dmSize = Len(DevM)
Nota: Si funciona en Windows XP
Nos vemos.
Guillermo
Averiguar la resolución actual y número de colores, usando API:
Seguramente sabrás cómo averiguar la resolución
de la pantalla usando el objeto Screen.
De esa forma podemos averiguar el alto y ancho de la misma, pero no el número de
colores.
Se usaría de esta forma:
With Screen
mResAlto = (.Height \ .TwipsPerPixelY)
mResAncho = (.Width \ .TwipsPerPixelX)
End With
Para poder saber el número de colores, usa este código, (tendrás que usar las declaraciones del API de Windows que te indico un poco más abajo)
' Esta llamada a EnumDisplay es para obtener la resolución actual ' mediante una llamada al API. Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevM) ' mResAncho = DevM.dmPelsWidth mResAlto = DevM.dmPelsHeight mResBits = DevM.dmBitsPerPel
' Código a poner en las declaraciones del formulario
Private mResAlto As Long
Private mResAncho As Long
Private mResBits As Long
Private DevM As DevMode
' API para cambiar la resolución de la pantalla
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
Const ENUM_CURRENT_SETTINGS As Long = -1&
'
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
' Las declaraciones de estas constantes están en: Wingdi.h
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
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
Cambiar / restaurar la resolución de forma rápida:
Rápida, lo que se dice rápida es también la siguiente que aún te tengo que mostrar, ésta lo que hace es cambiar la resolución a los valores que tu le indiques, ya que en ocasiones lo que realmente te puede interesar es poner la resolución que tu programa necesita.
Es decir, hacer algo tan sencillo como esto:
CambiarRes 800, 600, 32
En el código de ejemplo, te muestro todos los pasos, para saber cual es la resolución actual para después volver a ponerla.
El formulario de prueba tiene este aspecto:
Y este es el código completo del formulario de prueba:
'------------------------------------------------------------------------------
' Cambiar y restaurar la resolución de la pantalla, (método rápido) (04/Nov/01)
'
' ©Guillermo 'guille' Som, 2001
'------------------------------------------------------------------------------
Option Explicit
Private mResolucionCambiada As Boolean
Private mResAlto As Long
Private mResAncho As Long
Private mResBits As Long
Private DevM As DevMode
' API para cambiar la resolución de la pantalla
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
Const ENUM_CURRENT_SETTINGS As Long = -1&
Const ENUM_REGISTRY_SETTINGS As Long = -2&
'
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
' Las declaraciones de estas constantes están en: Wingdi.h
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
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
Private Sub cmdCambiarRes_Click()
' Cambiar la resolución a 800x600 colores de 32bits
' o a la indicada en los textboxes
CambiarRes txtResNueva(0), txtResNueva(1), txtResNueva(2)
End Sub
Private Sub cmdRestaurarRes_Click()
' Poner la resolución que había antes,
' si se ha cambiado...
If mResolucionCambiada Then
CambiarRes mResAncho, mResAlto, mResBits
End If
End Sub
Private Sub cmdSalir_Click()
Unload Me
End Sub
Private Sub Form_Load()
mResolucionCambiada = False
'
' Esta llamada a EnumDisplay es para obtener la resolución actual
' mediante una llamada al API.
DevM.dmSize = Len(DevM)
Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevM)
'
mResAncho = DevM.dmPelsWidth
mResAlto = DevM.dmPelsHeight
mResBits = DevM.dmBitsPerPel
'
' La he probado en Windows 2000,
' si no funciona en Windows 9x usa esta otra forma:
' With Screen
' mResAlto = (.Height \ .TwipsPerPixelY)
' mResAncho = (.Width \ .TwipsPerPixelX)
' End With
' mResBits = 32&
'
'
' Mostrar la resolución actual
txtResActual.Text = CStr(mResAncho) & " x " & CStr(mResAlto) & " x " & CStr(mResBits)
'
' Asignar la resolución a la que se cambiará:
txtResNueva(0).Text = "800"
txtResNueva(1).Text = "600"
txtResNueva(2).Text = "16"
'
' Si queremos cambiar en el form_load
'CambiarRes 800, 600, 16
End Sub
Private Sub CambiarRes(ByVal Ancho As Long, ByVal Alto As Long, ByVal Colores As Long)
' Cambiar la resolución de la pantalla (04/Nov/01)
'
' Lo que se va a cambiar
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
'
DevM.dmSize = Len(DevM)
DevM.dmPelsWidth = Ancho
DevM.dmPelsHeight = Alto
DevM.dmBitsPerPel = Colores
'
Call ChangeDisplaySettings(DevM, 0)
'
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
' Poner la resolución que había antes,
' si se ha cambiado...
If mResolucionCambiada Then
CambiarRes mResAncho, mResAlto, mResBits
End If
End Sub
Private Sub txtResActual_GotFocus()
' Seleccionar el texto al entrar en el textbox
With txtResActual
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub txtResNueva_GotFocus(Index As Integer)
' Seleccionar el texto al entrar en el textbox
With txtResNueva(Index)
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Enumerar las resoluciones disponibles y cambiar/restaurar la resolución de la pantalla:
En esta ocasión, el ejemplo que te voy a mostrar además de permitir averiguar la resolución actual y cambiar a una nueva, te muestra todas las resoluciones posibles, incluido el número de colores.
Te comento que he probado este código en
Windows XP y no funciona lo de cambiar la resolución.
Aunque si lista todos los valores posibles y por tanto muestra los valores actuales, tanto en el tamaño como en el número
de colores.
Al final de la página tienes una captura del formulario corriendo en el Windows
XP.
Este es el aspecto del formulario de pruebas (en Windows 2000):
Y este es el código completo:
'------------------------------------------------------------------------------
' Prueba para cambiar y restaurar la resolución de la pantalla (04/Nov/01)
'
' ©Guillermo 'guille' Som, 2001
'
' Parte del código es del ejemplo de cambiar la resolución
' publicado en mis páginas: http://www.elguille.info/vb/utilidades/cambiar_res.htm
' También tengo que reconocer que dicha información la basé en un artículo
' de la Knowledge Base de Microsoft:
' Changing the Screen Resolution at Run Time in Visual Basic 4.0
'------------------------------------------------------------------------------
Option Explicit
Private mResolucionCambiada As Boolean
Private mResAlto As Long
Private mResAncho As Long
Private mResBits As Long
Private DevM As DevMode
' Tipo y array para guardar las resoluciones disponibles
Private Type tResol
Width As Long
Height As Long
Bits As Integer
End Type
Private Disponibles() As tResol
Private mNuevaRes As Long
' API para cambiar la resolución de la pantalla
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
Const ENUM_CURRENT_SETTINGS As Long = -1&
Const ENUM_REGISTRY_SETTINGS As Long = -2&
'
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
' Las declaraciones de estas constantes están en: Wingdi.h
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
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
Private Sub CambiarRes(ByVal Ancho As Long, ByVal Alto As Long, ByVal Colores As Long)
' Cambiar la resolución de la pantalla (04/Nov/01)
'
' Lo que se va a cambiar
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
'
DevM.dmSize = Len(DevM)
DevM.dmPelsWidth = Ancho
DevM.dmPelsHeight = Alto
DevM.dmBitsPerPel = Colores
'
Call ChangeDisplaySettings(DevM, 0)
'
End Sub
Private Sub cmdCambiarRes_Click()
CambiarRes Disponibles(mNuevaRes).Width, Disponibles(mNuevaRes).Height, Disponibles(mNuevaRes).Bits
mResolucionCambiada = True
End Sub
Private Sub cmdRestaurarRes_Click()
' Poner la resolución que había antes
'
' Quita los comentarios para sólo hacerlo si se ha cambiado antes
'If mResolucionCambiada Then
CambiarRes mResAncho, mResAlto, mResBits
'End If
End Sub
Private Sub cmdSalir_Click()
Unload Me
End Sub
Private Sub Form_Load()
mResolucionCambiada = False
'
' Esta llamada a EnumDisplay es para obtener la resolución actual
' mediante una llamada al API.
DevM.dmSize = Len(DevM)
Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevM)
'
mResAncho = DevM.dmPelsWidth
mResAlto = DevM.dmPelsHeight
mResBits = DevM.dmBitsPerPel
'
' La he probado en Windows 2000,
' si no funciona en Windows 9x usa esta otra forma:
' With Screen
' mResAlto = (.Height \ .TwipsPerPixelY)
' mResAncho = (.Width \ .TwipsPerPixelX)
' End With
' mResBits = 32&
'
' La posición cero es para la resolución actual
ReDim Disponibles(0)
With Disponibles(0)
.Width = mResAncho
.Height = mResAlto
.Bits = mResBits
End With
'
' Mostrar la resolución actual
txtResActual.Text = CStr(mResAncho) & " x " & CStr(mResAlto) & " x " & CStr(mResBits)
'
txtResNueva.Text = ""
'
' Llenar el listbox con las resoluciones posibles
ResolucionesDisponibles
End Sub
Private Sub Form_Unload(Cancel As Integer)
If chkRestaurarAlCerrar.Value Then
CambiarRes mResAncho, mResAlto, mResBits
End If
End Sub
Private Sub ResolucionesDisponibles()
Dim i As Long
Dim a As Long
Dim s As String
'
' Vaciar el combo y el array
lstResoluciones.Clear
' El valor de la posición CERO es la actual
ReDim Preserve Disponibles(0)
'
DevM.dmSize = Len(DevM)
i = 0
Do
a = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
If a Then
' Mostrar en el listbox las resoluciones disponibles
s = Format$(DevM.dmPelsWidth, " @@@@") & " x " & _
Format$(DevM.dmPelsHeight, "@@@@") & " " & _
Format$(DevM.dmBitsPerPel, "@@") & " bits"
'
lstResoluciones.AddItem s
' Guardar esos datos en nuestro array
' de las resoluciones disponibles
ReDim Preserve Disponibles(i)
With Disponibles(i)
.Width = DevM.dmPelsWidth
.Height = DevM.dmPelsHeight
.Bits = DevM.dmBitsPerPel
End With
End If
Loop While a
End Sub
Private Sub lstResoluciones_Click()
Dim i As Long
i = lstResoluciones.ListIndex + 1
mNuevaRes = i
' Mostrar en el label la resolución seleccionada
txtResNueva.Text = Disponibles(i).Width & " x " & _
Disponibles(i).Height & " " & _
Disponibles(i).Bits & " bits"
End Sub
El segundo ejemplo funcionando en el Windows XP
Arriba tienes el link para el código de los dos proyectos de prueba.
