I'm making some resolution changing tests. My target is to temporarily change the resolution (ie. not change registry settings) and then restore the original resolution once the application completes. Thus I made this formless test project:
Code:
Option Explicit

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

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 Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End Type

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const CDS_FULLSCREEN = &H4
Private Const CDS_TEST = &H2

Private Const DISP_CHANGE_SUCCESSFUL = 0

Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000

Function ChangeResolution(ByVal NewWidth As Long, ByVal NewHeight As Long) As Boolean
    Dim DevM As DEVMODE
    EnumDisplaySettings 0, 0, DevM
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    DevM.dmPelsWidth = NewWidth
    DevM.dmPelsHeight = NewHeight
    If ChangeDisplaySettings(DevM, CDS_TEST) = DISP_CHANGE_SUCCESSFUL Then
        ChangeResolution = (ChangeDisplaySettings(DevM, CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL)
        If ChangeResolution Then
            SendMessage &HFFFF&, &H7E, DevM.dmBitsPerPel, ByVal (NewWidth And &HFFFF&) Or ((NewHeight And &H7FFF&) * &H10000)
        End If
    End If
End Function

Sub Main()
    Dim lngWidth As Long, lngHeight As Long
    lngWidth = Screen.Width \ Screen.TwipsPerPixelX
    lngHeight = Screen.Height \ Screen.TwipsPerPixelY
    If ChangeResolution(640, 480) Then
        MsgBox lngWidth & " x " & lngHeight
        ChangeResolution lngWidth, lngHeight
    End If
End Sub
The first run is alright. However, when I get as far as the second run suddenly lngWidth is the same as lngHeight and restoring the original resolution does not work. I have to use Display Settings window to get back.

So: how do I overcome this problem? Why width is suddenly the same as height? Surely some setting somewhere gets messed up, maybe because of an incorrect way to change resolution.

Also: what are the correct values for CDS_FULLSCREEN and CDS_TEST, because I see CDS_TEST with values 2 and 4, but CDS_FULLSCREEN with only 4? But they can't be the same, so somehow these two values have gotten mixed up with people, but unfortunatenaly I don't see any difference in behavior of the code.