Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Change & Reset Screen Resolution...

Posted on 2001-06-09
3
Medium Priority
?
305 Views
Last Modified: 2008-02-07
I am not adding the API and constants as I know they are working.
Ie. First sub sets the resolution to 800 x 600
In my form I check the resolution and if > 800 x 600 I set it to 800 x 600
Works fine.

Problem: Second Sub
I store the original settings (and I've checked, and they are the correct ones) in variables and then try to reset on the way out of my app.
In the querry unload and my unload event I call the second sub but it does nothing. I know it goes into the sub as I can get msgboxs from within it's structure.

Anyone???? How do I return to the original settings and should I include more than jus the screen dimensions when storing and resetting?

Public Sub sResolute()
    Dim dm As DEVMODE   ' display settings
    Dim retval As Long  ' return value
   
    ' Initialize the structure that will hold the settings.
    dm.dmSize = Len(dm)
    ' Get the current display settings.
    retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
    ' Change the resolution settings to 800x600.
    dm.dmPelsWidth = 800
    dm.dmPelsHeight = 600
    ' Test to make sure the changes are possible.
    retval = ChangeDisplaySettings(dm, CDS_TEST)
    If retval <> DISP_CHANGE_SUCCESSFUL Then
        Debug.Print "Cannot change to that resolution!"
    Else
        ' Change and save to the new settings.
        retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
        Select Case retval
        Case DISP_CHANGE_SUCCESSFUL
            Debug.Print "Resolution successfully changed!"
        Case DISP_CHANGE_RESTART
            Debug.Print "A reboot is necessary before the changes will take effect."
        Case Else
            Debug.Print "Unable to change resolution!"
        End Select
    End If
End Sub
Public Sub sResetResolute()
    Dim dm As DEVMODE   ' display settings
    Dim retval As Long  ' return value
   
    ' Initialize the structure that will hold the settings.
    dm.dmSize = Len(dm)
    ' Get the current display settings.
    retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
    ' Change the resolution settings to 800x600.
    dm.dmPelsWidth = 1074 'CInt(userWidth)
    dm.dmPelsHeight = 768 'CInt(userHeight)
    ' Test to make sure the changes are possible.
    retval = ChangeDisplaySettings(dm, CDS_TEST)
    If retval <> DISP_CHANGE_SUCCESSFUL Then
        Debug.Print "Cannot change to that resolution!"
    Else
        ' Change and save to the new settings.
        retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
        Select Case retval
        Case DISP_CHANGE_SUCCESSFUL
            Debug.Print "Resolution successfully changed!"
        Case DISP_CHANGE_RESTART
            Debug.Print "A reboot is necessary before the changes will take effect."
        Case Else
            Debug.Print "Unable to change resolution!"
        End Select
    End If
End Sub

0
Comment
Question by:vbWayne
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 1

Accepted Solution

by:
kdg2000 earned 273 total points
ID: 6170525
I have altered slightly your example and has received that:  


---------------------------------------- Module1 -------------------------------------------
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Public 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
Public Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" _
    (lpDevMode As DEVMODE, ByVal dwFalgs As Long) As Long
   
Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
    (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

---------------------------------------- end Module1 -------------------------------------

---------------------------------------- Form1 ----------------------------------------------
Private Sub Form_Load()
    sResolute
End Sub

Public Sub sResolute()
   Dim dm As DEVMODE   ' display settings
   Dim retval As Long  ' return value
   
   ' Initialize the structure that will hold the settings.
   dm.dmSize = Len(dm)
   ' Get the current display settings.
   'retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
   retval = EnumDisplaySettings(ByVal CLng(0), ByVal CLng(0), dm)
   ' Change the resolution settings to 800x600.
   dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
   dm.dmPelsWidth = 800
   dm.dmPelsHeight = 600
   ' Test to make sure the changes are possible.
   retval = ChangeDisplaySettings(dm, CDS_TEST)
   If retval <> DISP_CHANGE_SUCCESSFUL Then
       Debug.Print "Cannot change to that resolution!"
   Else
       ' Change and save to the new settings.
       retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
       Select Case retval
       Case DISP_CHANGE_SUCCESSFUL
           MsgBox "Resolution successfully changed!"
       Case DISP_CHANGE_RESTART
           MsgBox "A reboot is necessary before the changes will take effect."
       Case Else
           MsgBox "Unable to change resolution!"
       End Select
   End If
End Sub

Public Sub sResetResolute()
   Dim dm As DEVMODE   ' display settings
   Dim retval As Long  ' return value
   
   ' Initialize the structure that will hold the settings.
   dm.dmSize = Len(dm)
   ' Get the current display settings.
   retval = EnumDisplaySettings(ByVal CLng(0), ByVal CLng(0), dm)
   ' Change the resolution settings to 800x600.
   dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
   dm.dmPelsWidth = 1074 'CInt(userWidth)
   dm.dmPelsHeight = 768 'CInt(userHeight)
   ' Test to make sure the changes are possible.
   retval = ChangeDisplaySettings(dm, CDS_TEST)
   If retval <> DISP_CHANGE_SUCCESSFUL Then
       Debug.Print "Cannot change to that resolution!"
   Else
       ' Change and save to the new settings.
       retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
       Select Case retval
       Case DISP_CHANGE_SUCCESSFUL
           MsgBox "Resolution successfully changed!"
       Case DISP_CHANGE_RESTART
           MsgBox "A reboot is necessary before the changes will take effect."
       Case Else
           MsgBox "Unable to change resolution!"
       End Select
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    sResetResolute
End Sub
---------------------------------------- end Form1 ----------------------------------------
0
 
LVL 1

Author Comment

by:vbWayne
ID: 6170966
Still the same problem...it changes it on the way in but it doesn't change it back to it's original settings on the way out...when my app closes I am still at 800 x 600 and I should be back at 1074 x 728.

Wayne
0
 
LVL 1

Author Comment

by:vbWayne
ID: 6171852
'I am awarding the points even though the answer was found by myself. At least you gave it a shot and your altered API (any to DEVMODE) was a start.

'for anyone researching the question here is working code

'the problem was I had reversed my numbers...ie.I was grabbing the width as height and height as width...I saw the numbers as correct and assumed they were when in fact they were not as they were in reverse...also changed the API from passing as any to passing as DEVMODE

'bas module code
Public userWidth As Long
Public userHeight As Long
Public Declare Function ChangeDisplaySettings Lib "user32.dll" _
Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long

Public Declare Function EnumDisplaySettings Lib "user32.dll" _
Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, _
ByVal iModeNum As Long, lpDevMode As DEVMODE) As Long

Public Const ENUM_CURRENT_SETTINGS = -1


Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H2
Public Const CDS_FULLSCREEN = &H4
Public Const CDS_GLOBAL = &H8
Public Const CDS_SET_PRIMARY = &H10
Public Const CDS_RESET = &H40000000
Public Const CDS_SETRECT = &H20000000
Public Const CDS_NORESET = &H10000000
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Public Const DISP_CHANGE_FAILED = -1
Public Const DISP_CHANGE_BADMODE = -2
Public Const DISP_CHANGE_NOTUPDATED = -3
Public Const DISP_CHANGE_BADFLAGS = -4
Public Const DISP_CHANGE_BADPARAM = -5

' Declarations and such needed for the example:
' (Copy them to the (declarations) section of a module.)
Public Type DEVMODE
    dmDeviceName As String * 32
    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 * 32
    dmUnusedPadding As Integer
    dmBitsPerPixel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    ' The following only appear in Windows 95, 98, 2000
    dmICMMethod As Long
    dmICMIntent As Long
    dmMediaType As Long
    dmDitherType As Long
    dmReserved1 As Long
    dmReserved2 As Long
    ' The following only appear in Windows 2000
    dmPanningWidth As Long
    dmPanningHeight As Long
End Type

Public Sub sResolute()
    Dim dm As DEVMODE   ' display settings
    Dim retval As Long  ' return value
    ' Initialize the structure that will hold the settings.
    dm.dmSize = Len(dm)
    ' Get the current display settings.
    retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
    ' Change the resolution settings to 800x600.
    dm.dmPelsWidth = 800
    dm.dmPelsHeight = 600
    ' Test to make sure the changes are possible.
    retval = ChangeDisplaySettings(dm, CDS_TEST)
    If retval <> DISP_CHANGE_SUCCESSFUL Then
       ' Debug.Print "Cannot change to that resolution!"
    Else
        ' Change and save to the new settings.
        retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
        Select Case retval
        Case DISP_CHANGE_SUCCESSFUL
           ' Debug.Print "Resolution successfully changed!"
        Case DISP_CHANGE_RESTART
           ' Debug.Print "A reboot is necessary before the changes will take effect."
        Case Else
           ' Debug.Print "Unable to change resolution!"
        End Select
    End If
End Sub

Public Sub sResetResolute()
   
    Dim dm As DEVMODE   ' display settings
    Dim retval As Long  ' return value
   
    ' Initialize the structure that will hold the settings.
    dm.dmSize = Len(dm)
    ' Get the current display settings.
    retval = EnumDisplaySettings(vbNullString, ENUM_CURRENT_SETTINGS, dm)
    dm.dmPelsWidth = userWidth
    dm.dmPelsHeight = userHeight
    ' Test to make sure the changes are possible.
    retval = ChangeDisplaySettings(dm, CDS_TEST)
    If retval <> DISP_CHANGE_SUCCESSFUL Then
       ' MsgBox "Cannot change to that resolution!"
    Else
        ' Change and save to the new settings.
        retval = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
        Select Case retval
        Case DISP_CHANGE_SUCCESSFUL
            'MsgBox "Resolution successfully changed!"
        Case DISP_CHANGE_RESTART
           'MsgBox "A reboot is necessary before the changes will take effect."
        Case Else
           ' MsgBox "Unable to change resolution!"
        End Select
    End If
End Sub

'form code
'form activate events
Private Sub Form_Activate()
 userWidth = GetSystemMetrics(SM_CXSCREEN)
 userHeight = GetSystemMetrics(SM_CYSCREEN)
If Screen.Width > 800 And Screen.Height > 600 Then Call sResolute
End Sub
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question