Ejemplos usando el Api de windows para Visual basic

23 - Cambiar y reestablecer la resolución de la pantalla con el Api ChangeDisplaySetting

Contenido

Ejemplo 1
Ejemplo 2
Ejemplo 3
Relacionados

Ejemplo 1

Este ejemplo es del Api Guide y muestra como podemos cambiar la resolución de la pantalla, en este caso a 800 x 600 pixeles. y luego al descargar el form, se reestablece a la resolución original

La función Api que cambia la resolución es ChangeDisplaySettings. Mediante una función de ajuste llamada cambiarResolucion , es la que le debemos pasar en los 2 primeros parámetros los valores a cambiar.

Nota : es muy común intentar usar este sistema para adapatar los controles de un proyecto cuando el programa se ejecuta en una resolución diferente a la que fue creado, y esto no es recomendable , lo recomendable es redimensionar y posicionar los controles mediante código en el evento resize del formulario.

Código fuente en un formulario

'Constantes Option Explicit Const WM_DISPLAYCHANGE = &H7E Const HWND_BROADCAST = &HFFFF& Const EWX_LOGOFF = 0 Const EWX_SHUTDOWN = 1 Const EWX_REBOOT = 2 Const EWX_FORCE = 4 Const CCDEVICENAME = 32 Const CCFORMNAME = 32 Const DM_BITSPERPEL = &H40000 Const DM_PELSWIDTH = &H80000 Const DM_PELSHEIGHT = &H100000 Const CDS_UPDATEREGISTRY = &H1 Const CDS_TEST = &H4 Const DISP_CHANGE_SUCCESSFUL = 0 Const DISP_CHANGE_RESTART = 1 Const BITSPIXEL = 12 'Estructura 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 dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type ' Declaraciones de las funciones Api Private Declare Function ExitWindowsEx Lib "user32" ( _ ByVal uFlags As Long, _ ByVal dwReserved As Long) As Long 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 Private Declare Function GetDeviceCaps Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal nIndex As Long) As Long Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" ( _ ByVal lpDriverName As String, _ ByVal lpDeviceName As String, _ ByVal lpOutput As String, _ ByVal lpInitData As Any) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long 'Acá guardamos la resolucion actual Dim OldX As Long Dim OldY As Long Dim nDC As Long Private Sub cambiarResolucion(X As Long, Y As Long, Bits As Long) Dim DevM As DEVMODE Dim ScInfo As Long Dim erg As Long Dim an As VbMsgBoxResult 'recuperamos la info de la extructura devM erg = EnumDisplaySettings(0&, 0&, DevM) 'Establecmos valores a la extructura para cambiarla With DevM .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL .dmPelsWidth = X 'Ancho de pantalla .dmPelsHeight = Y 'Alto de pantalla .dmBitsPerPel = Bits 'cantidad de bits por pixeles End With 'ahora para cambiar la pantalla y luego verificamos si es posible erg = ChangeDisplaySettings(DevM, CDS_TEST) ' Chequamos si funcionó y handubo Ok Select Case erg& Case DISP_CHANGE_RESTART an = MsgBox("Querés reiniciar", vbYesNo + vbSystemModal, "Info") If an = vbYes Then erg& = ExitWindowsEx(EWX_REBOOT, 0&) End If 'el cambio salió bien Case DISP_CHANGE_SUCCESSFUL erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY) ScInfo = Y * 2 ^ 16 + X 'Notificamos a todas las ventanas el cambio de la resolucion SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo MsgBox "Se cambio la resolución", _ vbOKOnly + vbSystemModal Case Else MsgBox "Error: modo no soportado", vbOKOnly + vbSystemModal, "Error" End Select End Sub Private Sub Command1_Click() Dim nDC As Long 'Guardamos en las variables la resolucion actual para restaurarla OldX = Screen.Width / Screen.TwipsPerPixelX OldY = Screen.Height / Screen.TwipsPerPixelY nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&) 'Acá cambiamos la resolucion a 800 * 600 cambiarResolucion 800, 600, GetDeviceCaps(nDC, BITSPIXEL) End Sub Private Sub Form_Unload(Cancel As Integer) 'Acá restauramos la pantalla cambiarResolucion OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL) 'Eliminamos de memoria el dispositivo de contexto creado DeleteDC nDC End Sub

Ejemplo 2

Otro ejemplo para cambiar la resolución de la pantalla enviado por Helmuth Campos

Formulario para cambiar la resolución del monitor

vista previa del formulario para cambiar la resolucion del monitor

Nota: Al ejemplo falta agregarle la opción para cambiar la calidad o cantidad de colores de la pantalla

Descargar

Ejemplo 3

Programa mejorado

Desde este enlace se puede descargar este otro formulario enviado por Helmuth campos, que ahora permite indicar la profundidad de colores de la pantalla

Descargar

Relacionados

No hay ejemplos

Buscar en Recursos vb