resolution

[LeNenne]

Hello

How to change the resolution in VB6 ???

If one have 1200x900 and other have 800x 600
how can VB6 change or know what resolution the user have.

Thanks
Lenny

[Jx_Man]

There are several ways to get screen resolution :

First way

Put this in module

Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

Put this in form

Tmp As String
Tmp = GetSystemMetrics(SM_CXSCREEN) & "x" & GetSystemMetrics(SM_CYSCREEN)
Label1.Caption = Tmp

Second way

Label1.Caption = "Resolution = " & Screen.Width / Screen.TwipsPerPixelX _
   & " X " & Screen.Height / Screen.TwipsPerPixelY
End Sub

For changing Resolution with your criteria :
Require two buttons. One as 1200x900 and other as 800x600

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 Command1_Click()
Dim nDC As Long

    'Create Device Context Compatible With Screen
    nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)

    'Change Resolution
    ChangeResolution 1200, 900, GetDeviceCaps(nDC, BITSPIXEL)
End Sub

Private Sub Command2_Click()
'Restore Old Resolution
    ChangeResolution 800, 600, GetDeviceCaps(nDC, BITSPIXEL)

    'Delete Device Context
    DeleteDC nDC
End Sub

[LeNenne]

Thank's JX Man

I shall try this example.

Have a question can it been automatically done