Avis
Junior Poster
Joined: 07 Oct 2003
Posts: 510
Location: India
|
 Posted: Oct 8th, 2003 04:00 AM Post subject: Changing Screen Resolution |
 |
|
The following code lets you change the screen resolution.
| Code: | Option Explicit
Private Const EWX_REBOOT = 2
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H4
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Type typDevMODE
dmDeviceName As String * CCDEVICENAME
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 * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function EnumDisplaySettings Lib _
"user32" Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, ByVal iModeNum As Long, _
lptypDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib _
"user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, _
ByVal dwFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib _
"user32" (ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long
Public Function ChangeDisplayResolution(NewWidth As Long, _
NewHeight As Long) As Boolean
'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.
Dim typDM As typDevMODE
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
Private Sub Form_Load()
'Change Resolution to 800x600
ChangeDisplayResolution 800, 600
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Change Resolution to 1024x768
ChangeDisplayResolution 1024, 768
End Sub |
|
|
