Cambiar configuración de Pantalla

Introducción

Sistema desarrollado en Vbasic 6.0 para Cambiar la configuración de la Pantalla. 

Basado en un artículo de ©Guillermo 'guille' Som, 1998-2001 Cambiar la resolución de la pantalla (25/Jun/98) Revisado: 03/May/2001

Nota:

Agregados al código original: 
Se intentó mostrar los efectos del cambio de configuración de la 
pantalla usando para ello un form que usa en el atributo Picture 
un Mapa de bits generado con la utilidad Paint de Windows. 
Es decir para notar el efecto del cambio respecto a los colores 
se usó un mapa de bits que tuviere todos los colores posibles (se 
copió los colores de Paint - Colores - Modificar colores - Defi 
nir colores personalizados) 
En el mismo mapa de bits se dibujó un cuadrado perfecto, con sus 
dos diagonales y un círculo inscripto, con el fin de observar las 
deformaciones que sufre un cuadrado o un círculo perfecto debido 
a los cambios de resolución. 

Se probó la utilidad en distintos equipo y distintos monitores y 
se descubrió que la resolución más baja (de todos los equipos que 
probamos) era la de 320 x 200 píxeles (ancho y alto respectiva 
mente) 
Debido a estos datos se configuró el form de las siguiente forma: 

FrmCambiarRes.Width  = 4800 Twips = 4800/15= 320 píxeles 
FrmCambiarRes.Height = 2595 Twips = 2595/15= 173 píxeles 

320 x 200 píxeles Pantalla completa 
320 x 173 píxeles Tamaño máximo del Form 
320 x 27 píxeles Espacio libre para la barra estándar de Windows 

De esta manera se logró que todo el form se pudiese ver aun con 
la resolución más baja. 

Otra mejora al código original fue que las resoluciones aparecie 
sen agrupadas por bits de colores, sin repetir, y en orden ascen 
dente. 
bits color 
 2 (monitores muy antiguos, blanco y negro) 
 4 
 8 
16 
32 
Se usaron 5 ListBox, numerados del 1 al 5, para contener las 
distintas configuraciones discriminadas por bits de color. 
Para hacer corresponder los bits de colores con estos ListBox 
numerados se usó logaritmos, de la siguiente manera. 

 x función de      y 
----------------------- 
 2 log( 2)/log(2)= 1 
 4 log( 4)/log(2)= 2 
 8 log( 8)/log(2)= 3 
16 log(16)/log(2)= 4 
32 log(32)/log(2)= 5 

El código:

'=============================================================================
' Cambiar la resolución de la pantalla                  (25/Jun/98)
'
' Revisado: 03/May/2001
'
' ©Guillermo 'guille' Som, 1998-2001
'
' Basado en un artículo de la Knowledge Base:
' Changing the Screen Resolution at Run Time in Visual Basic 4.0
'=============================================================================
' Revisado: 27/Jun/2010 por Eduardo 'Edy' Prez
'=============================================================================
Option Explicit
Dim tonos%, ancho%, altor%
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
    (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean 'API "1"
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
    (lpDevMode As Any, ByVal dwflags As Long) As Long                               'API "2"
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
'Las declaraciones de estas constantes están en: Wingdi.h
Const DM_BITSPERPEL = &H40000             'bit de colores
Const DM_PELSWIDTH = &H80000              'ancho de pantalla
Const DM_PELSHEIGHT = &H100000            'alto  de pantalla
Const ENUM_CURRENT_SETTINGS As Long = -1& 'configuracion monitor

Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME 'constantes impresor
    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
    dmtonos As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer

    dmFormName As String * CCFORMNAME 'constantes monitor
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    End Type
 Dim DevM As DEVMODE
'=============================================================================
Public Sub Form_Load()
Dim i%(5), a%, w%, co%
Dim repe$, da$
Dim H!
    repe$ = "              |"
'           "1234_1234___12|"
    i%(1) = 0 ' 2 bits (monitores blanco y negro)
    i%(2) = 0 ' 4 bits
    i%(3) = 0 ' 8 bits
    i%(4) = 0 '16 bits
    i%(5) = 0 '32 bits
    With Screen
    Call Configuracion
                     co% = Log(DevM.dmBitsPerPel) / Log(2) 'consigue bits de color
           OptionBit(co%).Value = True
Call OptionBit_Click(co%)
End With
'=============================================================================
                                        H! = 0
Do
                                        H! = H! + 1
           a% = EnumDisplaySettings(0&, H!, DevM) 'comando API para conseguir configuraciones del monitor, necesita API "1"
                              da$ = Format$(DevM.dmPelsWidth, "@@@@") & " " & _
                              Format$(DevM.dmPelsHeight, "@@@@") & "   " & _
                              Format$(DevM.dmBitsPerPel, "@@") & "|" '1234 1234   12|
            w% = InStr(repe$, da$)
         If w% = 0 Then
              repe$ = repe$ + da$ 'tomar sólo las configuraciones diferentes!!!
           co% = Log(Val(Mid$(da$, 13, 2))) / Log(2) '1234 1234   12|
   ListRes(co%).AddItem da$
        i%(co%) = i%(co%) + 1
     End If
Loop While a%
'=============================================================================
BotCambiarRes.Enabled = False
End Sub
'=============================================================================
Private Sub BotCambiarRes_Click()
                           DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
                           DevM.dmFields = DevM.dmFields Or DM_BITSPERPEL 'para cambiar de bits de colores
                           DevM.dmBitsPerPel = tonos% 'bit de colores
                           DevM.dmPelsWidth = ancho%
                           DevM.dmPelsHeight = altor%
Call ChangeDisplaySettings(DevM, 0) 'comando API para cambiar configuracion de pantalla, necesita API "2"
Call Configuracion
End Sub
'=============================================================================
Private Sub Configuracion()
Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevM) 'API que consigue la configuracion actual del monitor
                                   Label1 = Format$(DevM.dmPelsWidth, "@@@@") & " " & _
                                            Format$(DevM.dmPelsHeight, "@@@@") ' & "   <== Resolución actual" 'quitado porque se muestra en el form!!!
End Sub
'=============================================================================
Private Sub OptionBit_Click(Index As Integer)
                           Dim r%
                           For r% = 1 To 5
                       ListRes(r%).Visible = False
                          Next r%
                    ListRes(Index).Visible = True
BotCambiarRes.Enabled = False
End Sub
'=============================================================================
      Private Sub ListRes_Click(Index As Integer)
 Label2.Caption = Left$(ListRes(Index).Text, 9) & "   <== Cambiar a"
                   tonos% = 2 ^ Index
          ancho% = Mid$(ListRes(Index).Text, 1, 4) '1234 1234   12|
          altor% = Mid$(ListRes(Index).Text, 6, 4)
BotCambiarRes.Enabled = True
End Sub
'=============================================================================

Atención:
A este código le faltan los manejos de error.
En ciertos monitores, al seleccionar la resolución que entregó el código API,
da el monitor un error de Frecuencia incorrecta y se deja de ver.
Hemos notado otro detalle importante:
Las resoluciones que muestra siempre son ancho x alto (en píxeles); en ese 
orden, primero en ancho y luego el alto.
Entonces, lo normal, es que el ancho siempre sea mayor que el alto, pero 
ciertos monitores entregan resoluciones donde el ancho es inferior al alto, 
en estos casos, al cambiar la configuración con esta aplicación, 
todo lo mostrado en la pantalla se encontrará girado 90 grados hacia la 
izquierda (movimiento contrario a las agujas del reloj).

Espacios de nombres usados en el código de este artículo:

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#stdole2.tlb#OLE Automation
Object={6FBA474E-43AC-11CE-9A0E-00AA0062BB4C}#1.0#0; SYSINFO.OCX