Changing screen resolution with VB 2005

EDN Admin

Well-known member
Joined
Aug 7, 2010
Messages
12,794
Location
In the Machine
Im having a difficult time converting a Windows API call that works fine in VB6 to run in VB 2005 (Windows XP with SP2 in both cases).  I reduced the problem code down to its core which is below. Im trying to change the screen resolution with the ChangeDisplaySettingsEx call; the idea is that on entering the program it shifts to high resolution and at the end it restores the original settings. I left the restore part out because I get the same error. Which is "An invalid parameter was passed in. This can include an invalid flag or combination of flags."  Im trying to use exactly the same parameters, but somewhere in the conversion process from VB6 a fatal change crept in.  My guess is that its either in the ByRef/ByVal or Short/Integer/Long alternatives, or in the conversion of the Devmode structure which included fixed-length strings (OK in VB6 but not allowed in VB.NET). But all my fiddling so far has not produced a solution.  I got the same error code back in VB6 when I tried to set a display frequency that was not supported at the resolution I requested, but even leaving the values unmodified (in effect setting them to what they are now, with no change) gives the same error. Any ideas? So far as I can tell, there is no alternative to the API to accomplish this goal; would be interested to know if I missed it.
<font face="Courier New, Courier, Monospace" size=2>  ==========================
Imports System, .Drawing, .Windows.Forms
Public Class frmDX9RKS
    Inherits Form
 ==== screen-resolution API, constants, etc. ====</font>
<font face="Courier New, Courier, Monospace" size=2>  Public Declare Function ChangeDisplaySettingsEx Lib "user32" _
    Alias "ChangeDisplaySettingsExA" _
    (ByRef lpszDeviceName As Integer, _
     ByRef lpDevMode As DEVMODE, _
     ByVal hWnd As Integer, _
     ByVal dwFlags As Integer, _
     ByRef lParam As Integer) As Integer</font>
<font face="Courier New, Courier, Monospace" size=2>  Const CCDEVICENAME As Integer = 32
  Const CCFORMNAME As Integer = 32</font>
<font face="Courier New, Courier, Monospace" size=2>  Enum CDSXRC As Integer change-display-settings return codes
    From winuser.h
    DISP_CHANGE_SUCCESSFUL = 0
    DISP_CHANGE_RESTART = 1
    DISP_CHANGE_FAILED = -1
    DISP_CHANGE_BADMODE = -2
    DISP_CHANGE_NOTUPDATED = -3
    DISP_CHANGE_BADFLAGS = -4
    DISP_CHANGE_BADPARAM = -5
  End Enum</font>
<font face="Courier New, Courier, Monospace" size=2>  Public Structure DEVMODE
    <VBFixedString(CCDEVICENAME), _
      System.Runtime.InteropServices.MarshalAs( _
      System.Runtime.InteropServices.UnmanagedType.ByValArray, _
      SizeConst:=(CCDEVICENAME))> Public dmDeviceName() As Char
    Dim dmSpecVersion As Short
    Dim dmDriverVersion As Short
    Dim dmSize As Short
    Dim dmDriverExtra As Short
    Dim dmFields As Integer
    Dim dmOrientation As Short
    Dim dmPaperSize As Short
    Dim dmPaperLength As Short
    Dim dmPaperWidth As Short
    Dim dmScale As Short
    Dim dmCopies As Short
    Dim dmDefaultSource As Short
    Dim dmPrintQuality As Short
    Dim dmColor As Short
    Dim dmDuplex As Short
    Dim dmYResolution As Short
    Dim dmTTOption As Short
    Dim dmCollate As Short
    <VBFixedString(CCFORMNAME), _
      System.Runtime.InteropServices.MarshalAs( _
      System.Runtime.InteropServices.UnmanagedType.ByValArray, _
      SizeConst:=(CCFORMNAME))> Public dmFormName() As Char
    Dim dmUnusedPadding As Short
    Dim dmBitsPerPel As Short
    Dim dmPelsWidth As Integer
    Dim dmPelsHeight As Integer
    Dim dmDisplayFlags As Integer
    Dim dmDisplayFrequency As Integer
    Dim dmICMMethod As Integer NT 4.0
    Dim dmICMIntent As Integer NT 4.0
    Dim dmMediaType As Integer NT 4.0
    Dim dmDitherType As Integer NT 4.0
    Dim dmReserved1 As Integer NT 4.0
    Dim dmReserved2 As Integer NT 4.0
    Dim dmPanningWidth As Integer Win2000
    Dim dmPanningHeight As Integer Win2000
  End Structure</font>
<font face="Courier New, Courier, Monospace" size=2>  Public Declare Function EnumDisplaySettings Lib "user32" _
    Alias "EnumDisplaySettingsA" ( _
    ByVal lpszDeviceName As Integer, _
    ByVal iModeNum As Integer, _
    ByRef lpDevMode As DEVMODE) As Boolean</font>
<font face="Courier New, Courier, Monospace" size=2>Shared Sub Main()
  Dim frm As New frmDX9RKS()
End Sub    Main</font>
<font face="Courier New, Courier, Monospace" size=2>Public Sub New()
  Const DM_PELSWIDTH As Integer = &H80000
  Const DM_PELSHEIGHT As Integer = &H100000
  Const DM_DISPLAYFREQUENCY As Integer = &H400000
  Const CDS_TEST As Integer = &H4</font>
<font face="Courier New, Courier, Monospace" size=2>  InitializeComponent()  required by the Windows Form Designer.
  Add any initialization after the Initialize-Component() call.</font>
<font face="Courier New, Courier, Monospace" size=2>    Const HiResW As Integer = 1600 hi-res width in pixels
    Const HiResH As Integer = 1200 hi-res height in pixels
    Const ENUM_CURRENT_SETTINGS As Integer = -1</font>
<font face="Courier New, Courier, Monospace" size=2>    Static OldWd As Integer screen width in pixels
    Static OldHt As Integer screen height in pixels
    Static OldFreq As Integer screen-refresh frequency</font>
<font face="Courier New, Courier, Monospace" size=2>    Dim DevM As New DEVMODE  added New in V3.2, 3/22/06
    Dim boRetn As Boolean boolean return code
    Dim ResChgRtCd As Integer As CDSXRC resolution-change return code</font>
<font face="Courier New, Courier, Monospace" size=2>Debug.Print("Original - width: " & DevM.dmPelsWidth & _
"  Height: " & DevM.dmPelsHeight & _
"  Freq: " & DevM.dmDisplayFrequency & _
"  DevmodeSize: " & DevM.dmSize & _
"  dmFields: " & DevM.dmFields)</font>
<font face="Courier New, Courier, Monospace" size=2>    DevM.dmSize = CShort(Len(DevM)) set up dev-mode
      set field bits: Horiz, Vert, Freq
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY</font>
<font face="Courier New, Courier, Monospace" size=2>      save orig values and set to high resolution
      boRetn = EnumDisplaySettings(0, ENUM_CURRENT_SETTINGS, DevM)
Debug.Print("Color: " & DevM.dmBitsPerPel & " bits/pixel")</font>
<font face="Courier New, Courier, Monospace" size=2>      OldWd = DevM.dmPelsWidth save orig width in pixels
      OldHt = DevM.dmPelsHeight save orig height in pixels
      OldFreq = DevM.dmDisplayFrequency save orig refresh freq
      DevM.dmPelsWidth = HiResW
      DevM.dmPelsHeight = HiResH
      DevM.dmDisplayFrequency = 60 use lower (hard-coded) freq for LCD hi-res
Debug.Print("Before change - width: " & DevM.dmPelsWidth & _
"  Height: " & DevM.dmPelsHeight & _
"  Freq: " & DevM.dmDisplayFrequency & _
"  DevmodeSize: " & DevM.dmSize & _
"  dmFields: " & DevM.dmFields)
Stop
      ResChgRtCd = ChangeDisplaySettingsEx(0, DevM, 0, CDS_TEST, 0)</font>
<font face="Courier New, Courier, Monospace" size=2>      If ResChgRtCd <> CDSXRC.DISP_CHANGE_SUCCESSFUL Then if change failed,
        subBadResChgDiag((ResChgRtCd)) tell why
        Stop
        Exit Sub
      End If</font>
<font face="Courier New, Courier, Monospace" size=2>End Sub</font>
<font face="Courier New, Courier, Monospace" size=2>Private Sub subBadResChgDiag(ByRef CDSRetCode As Integer)
  Dim strErr As String
  Dim strBase As String</font>
<font face="Courier New, Courier, Monospace" size=2>  strBase = "Screen-resolution change failed;" & vbCrLf & vbCrLf & "Code is: "</font>
<font face="Courier New, Courier, Monospace" size=2>  Select Case CDSRetCode
    Case CDSXRC.DISP_CHANGE_RESTART
      strErr = strBase & "CHANGE_RESTART"
    Case CDSXRC.DISP_CHANGE_FAILED
      strErr = strBase & "CHANGE_FAILED"
    Case CDSXRC.DISP_CHANGE_BADMODE
      strErr = strBase & "CHANGE_BADMODE"
    Case CDSXRC.DISP_CHANGE_NOTUPDATED
      strErr = strBase & "CHANGE_NOTUPDATED"
    Case CDSXRC.DISP_CHANGE_BADFLAGS
      strErr = strBase & "CHANGE_BADFLAGS"
    Case CDSXRC.DISP_CHANGE_BADPARAM
      strErr = strBase & "CHANGE_BADPARAM"
    Case Else
      strErr = strBase & "Unknown resolution-change error"
  End Select
  MsgBox(strErr)</font>
<font face="Courier New, Courier, Monospace" size=2>End Sub</font>
<font face="Courier New, Courier, Monospace" size=2>End Class
</font>

View the full article
 
Back
Top