'Usage: ChangeDisplayResolution 800, 600
'Returns: True if succesful, false otherwise
'Comments: Problems have been reported using this code for
'resolutions higher than 1024 X 768. We recommend not
' using this
'snippet to go above this limit.
Public Function ChangeDisplayResolution(ByVal NewWidth As _
Long, ByVal NewHeight As Long) As Boolean
Dim typDM As DEVMODE
Dim lRet As Long
Dim iResp As Integer
'typDM = pointer to info about current
'display settings
lRet = EnumDisplaySettings(0, 0, typDM)
If lRet = 0 Then Exit Function
' Set the new resolution.
With typDM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = NewWidth
.dmPelsHeight = NewHeight
End With
'Do the update -- Pass update structure to
'ChangeDisplaySettings API function
lRet = ChangeDisplaySettings(typDM, CDS_UPDATEREGISTRY)
Select Case lRet
Case DISP_CHANGE_RESTART
iResp = MsgBox _
("You must restart your computer to apply " & _
"these changes." & _
vbCrLf & vbCrLf & "Restart now?", _
vbYesNo + vbInformation, "Screen Resolution " & _
"Changed")
If iResp = vbYes Then
ChangeDisplayResolution = True
Reboot
End If
Case DISP_CHANGE_SUCCESSFUL
ChangeDisplayResolution = True
Case Else
ChangeDisplayResolution = False
End Select
End Function
Private Sub Reboot()
Dim lRet As Long
lRet = ExitWindowsEx(EWX_REBOOT, 0)
End Sub
|