' ChangRez sample by Matt Hart - mhart@taascforce.com
' http://www.webczar.com/defcon/mh
'
' How to change video resolution in Windows 95.
' The WinSDK API declarations for VB does NOT include
' this useful procedure, nor does it include some
' of the needed constants. I had to figure out the API
' declaration and go to the Platform SDK
' find most of the constants.
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private 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 Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpInitData As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (lpszDeviceName As Any, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Sub Command1_Click()
Dim l As Long, Flags As Long, x As Long
x = List1.ListIndex
D(x).dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
Flags = CDS_UPDATEREGISTRY
l = ChangeDisplaySettings(D(x), Flags)
Select Case l
Case DISP_CHANGE_RESTART
l = MsgBox("This change will not take effect until you reboot the system. Reboot now?", vbYesNo)
If l = vbYes Then
Flags = 0
l = ExitWindowsEx(EWX_REBOOT, Flags)
End If
Case DISP_CHANGE_SUCCESSFUL
Case Else
MsgBox "Error changing resolution! Returned: " & l
End Select
End Sub
Private Sub Form_Load()
Dim l As Long, lMaxModes As Long
Dim lBits As Long, lWidth As Long, lHeight As Long
lBits = GetDeviceCaps(hdc, BITSPIXEL)
lWidth = Screen.Width \ Screen.TwipsPerPixelX
lHeight = Screen.Height \ Screen.TwipsPerPixelY
lMaxModes = 8
ReDim D(0 To lMaxModes) As DEVMODE
lNumModes = 0
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Do While l
List1.AddItem D(lNumModes).dmPelsWidth & "x" & D(lNumModes).dmPelsHeight & "x" & D(lNumModes).dmBitsPerPel
If lBits = D(lNumModes).dmBitsPerPel And _
lWidth = D(lNumModes).dmPelsWidth And _
lHeight = D(lNumModes).dmPelsHeight Then
List1.ListIndex = List1.NewIndex
End If
lNumModes = lNumModes + 1
If lNumModes > lMaxModes Then
lMaxModes = lMaxModes + 8
ReDim Preserve D(0 To lMaxModes) As DEVMODE
End If
l = EnumDisplaySettings(ByVal 0, lNumModes, D(lNumModes))
Loop
lNumModes = lNumModes - 1
End Sub