[VB6] How Do I Change The Screen Resolution Only For My Program?
CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 1 of 1

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

  1. #1
    Join Date
    Jul 2001
    Location
    Sunny South Africa
    Posts
    11,092

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

    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 :

    Code:
    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.
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


Windows Mobile Development Center


Click Here to Expand Forum to Full Width

This is a CodeGuru survey question.


Featured


HTML5 Development Center