Changing screen resolution with VB 2005

I'm 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. I'm 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." I'm trying to use exactly the same parameters, but somewhere in the conversion process from VB6 a fatal change crept in. My guess is that it's 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.

' ==========================
'Imports System, .Drawing, .Windows.Forms
Public Class frmDX9RKS
Inherits Form
'==== screen-resolution API, constants, etc. ====

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

Const CCDEVICENAME As Integer = 32
Const CCFORMNAME As Integer = 32

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

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

Public Declare Function EnumDisplaySettings Lib "user32" _
Alias "EnumDisplaySettingsA" ( _
ByVal lpszDeviceName As Integer, _
ByVal iModeNum As Integer, _
ByRef lpDevMode As DEVMODE) As Boolean

Shared Sub Main()
Dim frm As New frmDX9RKS()
End Sub 'Main

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

InitializeComponent() 'required by the Windows Form Designer.
' Add any initialization after the Initialize-Component() call.

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

Static OldWd As Integer 'screen width in pixels
Static OldHt As Integer 'screen height in pixels
Static OldFreq As Integer 'screen-refresh frequency

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

Debug.Print("Original - width: " & DevM.dmPelsWidth & _
" Height: " & DevM.dmPelsHeight & _
" Freq: " & DevM.dmDisplayFrequency & _
" DevmodeSize: " & DevM.dmSize & _
" dmFields: " & DevM.dmFields)

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

'save orig values and set to high resolution
boRetn = EnumDisplaySettings(0, ENUM_CURRENT_SETTINGS, DevM)
Debug.Print("Color: " & DevM.dmBitsPerPel & " bits/pixel")

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)

If ResChgRtCd <> CDSXRC.DISP_CHANGE_SUCCESSFUL Then 'if change failed,
subBadResChgDiag((ResChgRtCd)) ' tell why
Stop
Exit Sub
End If

End Sub

Private Sub subBadResChgDiag(ByRef CDSRetCode As Integer)
Dim strErr As String
Dim strBase As String

strBase = "Screen-resolution change failed;" & vbCrLf & vbCrLf & "Code is: "

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)

End Sub

End Class

Answer this question