Attribute VB_Name = "Module1"
Option Explicit

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 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 GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) 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
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

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

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

Public Function ChangeScreenResolution(ByVal DisplaySettingRes As String) As Boolean

    Dim strCurrentResolution As String
    Dim lngReturnValDC As Long
    Dim lngReturnValDisplay As Long
    Dim MonitorSupportInfo As DEVMODE
    Dim ScInfo As Long

    On Error GoTo errHandler
    ChangeScreenResolution = False
    
    ' Temproarily store the current display resolution
    strCurrentResolution = (Screen.Width / Screen.TwipsPerPixelX) & "x" & _
    (Screen.Height / Screen.TwipsPerPixelY)
    
    ' Create a device context, compatible with the screen, follow this by
    ' checking the modes, colours etc this monitor supports & storing this
    ' info into the MonitorSupportInfo variable.
    lngReturnValDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    lngReturnValDisplay = EnumDisplaySettings(0&, 0&, MonitorSupportInfo)
    
    ' Populate the supported displaymodes structure with the info we want to change
    ' the screen resolution to. This will be used below.
    With MonitorSupportInfo
        .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
        .dmPelsWidth = Mid(DisplaySettingRes, 1, InStr(DisplaySettingRes, "x") - 1)
        .dmPelsHeight = Mid(DisplaySettingRes, InStr(DisplaySettingRes, "x") + 1, Len(DisplaySettingRes))
        .dmBitsPerPel = GetDeviceCaps(lngReturnValDC, BITSPIXEL)
    End With
    
    ' Attempt to alter the current resolution to the new mode listed in the MonitorSupportInfo structure.
    ' Then check the result. If the system needs to be restarted to pick the changes up, the user is notified.
    ' If the screen update worked, a true value is passed back to the function to reflect this, and the
    ' sendmessage call is used to notify any other running processes of the change.
    lngReturnValDisplay = ChangeDisplaySettings(MonitorSupportInfo, CDS_TEST)

    Select Case lngReturnValDisplay
        Case DISP_CHANGE_RESTART
        
            If (MsgBox("You will need to reboot for the changes to take effect." & _
            vbCrLf & "Proceed with reboot?", vbYesNo, "Restart System?") = vbYes) Then
                lngReturnValDisplay = ExitWindowsEx(EWX_REBOOT, 0&)
            End If
            
        Case DISP_CHANGE_SUCCESSFUL
        
            lngReturnValDisplay = ChangeDisplaySettings(MonitorSupportInfo, CDS_UPDATEREGISTRY)
            ScInfo = Y * 2 ^ 16 + x
            SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo
            
        ' If the change was unsuccessful, return the screen resolution to how it was, then return a false
        ' value to the function, indicating that an error occurred & the display cannot be changed.
        Case Else
        
            ChangeScreenResolution strCurrentResolution
            
    End Select
    
    
    DeleteDC lngReturnValDC
    Exit Function
    
errHandler:
    
    'If an error occurred, reset the screen resolution to how it was & return a false value to the function.
    ChangeScreenResolution strCurrentResolution

    ChangeScreenResolution = False
End Function

Private Sub Form_Load()

End Sub