[VB6] How Do I Change The Screen Resolution Only For My Program?

[HanneSThEGreaT]

Q: How Do I Change The Screen Resolution Only For My Program?

A: Start A New Project, And Add The Following Code To The Form :

Option Explicit

'The EnumDisplaySettings function retrieves information about one of the graphics modes for a display device
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

'The ChangeDisplaySettings function changes the settings of the default display device to the specified graphics mode.
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long

'Logs off the interactive user, shuts down the system, or shuts down and restarts the system.
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

'The GetDeviceCaps function retrieves device-specific information for the specified device.
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

'The CreateDC function creates a device context (DC) for a device using the specified name
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

'The DeleteDC function deletes the specified device context (DC).
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

'Sends the specified message to a window or windows
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 EWX_LOGOFF = 0 'Log Off
Private Const EWX_SHUTDOWN = 1 'Shut Down
Private Const EWX_REBOOT = 2 'Reboot
Private Const EWX_FORCE = 4 'Force Reboot

Private Const CCDEVICENAME = 32 'Device Name
Private Const CCFORMNAME = 32 'Name of the Form to use; For Example, "Letter" or "Legal"
Private Const DM_BITSPERPEL = &H40000 'Specifies the color resolution
Private Const DM_PELSWIDTH = &H80000 'Specifies the width, in pixels, of the visible device surface.
Private Const DM_PELSHEIGHT = &H100000 'Specifies the height, in pixels, of the visible device surface
Private Const BITSPIXEL = 12 'Bits per Pixel Setting

Private Const CDS_UPDATEREGISTRY = &H1 'Update Registry
Private Const CDS_TEST = &H4 'Allows an application to determine which graphics modes are actually valid, without causing the system to change to the settings.
Private Const DISP_CHANGE_SUCCESSFUL = 0 'Was The Change Successful?
Private Const DISP_CHANGE_RESTART = 1 'Does Change Require Restart?

Private Const WM_DISPLAYCHANGE = &H7E 'Display Has Changed
Private Const HWND_BROADCAST = &HFFFF& 'Broadcast to all Windows

'The DEVMODE data structure contains information about the initialization and environment of a printer or a display device.
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

Dim OldX As Long 'Old X Setting
Dim OldY As Long 'Old Y Setting
Dim nDC As Long 'Old Device

Sub ChangeResolution(X As Long, Y As Long, BitsPerPixel As Long)

    Dim DevM As DEVMODE 'Contains DEVMODE Info
    Dim ScreenInfo As Long 'Screen Info
    Dim lResult As Long 'Result of Functions
    Dim intAnsw As VbMsgBoxResult 'Messagebox Question

    'Get DisplaySettings Information
    lResult = EnumDisplaySettings(0&, 0&, DevM)

    'Change Pixel Settings
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
    DevM.dmPelsWidth = X 'Screen Width
    DevM.dmPelsHeight = Y 'Screen Height
    DevM.dmBitsPerPel = BitsPerPixel 'Can Be 4, 8, 16, 24, 32
    
    'Try To Change Display Settings
    lResult = ChangeDisplaySettings(DevM, CDS_TEST)
    
    'If Succesful
    Select Case lResult&

        'Requires A Restart
        Case DISP_CHANGE_RESTART
            intAnsw = MsgBox("You Must Restart To Apply These Changes." & _
            vbCrLf & "Restart Now ¿", _
            vbYesNo, "Screen Resolution")

            If intAnsw = vbYes Then 'Restart
                lResult& = ExitWindowsEx(EWX_REBOOT, 0&)
            End If
            
        'Successful Without The Need Of Restart
        Case DISP_CHANGE_SUCCESSFUL
            lResult = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
            
            ScreenInfo = Y * 2 ^ 16 + X
            
            'Notify all the windows of the screen resolution change
            
            SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal BitsPerPixel, ByVal ScreenInfo
            MsgBox "Screen Resolution Changed", vbInformation, "Screen Resolution Changed"

        Case Else
            MsgBox "Mode Not Supported", vbOKOnly + vbSystemModal, "Error"
        
        End Select
        
End Sub
Private Sub Form_Load()

    Dim nDC As Long
    
    'Retrieve Screen's Current Resolution
    OldX = Screen.Width / Screen.TwipsPerPixelX
    OldY = Screen.Height / Screen.TwipsPerPixelY
    
    'Create Device Context Compatible With Screen
    nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    
    'Change Resolution
    ChangeResolution 640, 480, GetDeviceCaps(nDC, BITSPIXEL)
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    'Restore Old Resolution
    ChangeResolution OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL)

    'Delete Device Context
    DeleteDC nDC

End Sub

Example Attached.