VB and VBA Users Source Code: Changing the screen resolution/colors
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Changing the screen resolution/colors
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, January 24, 2001
Hits:
830
Category:
Windows API
Article:
Below is a routine which changes the display resolution/colors. Option Explicit Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Const CDS_UPDATEREGISTRY = &H1, CDS_TEST = &H4, DISP_CHANGE_SUCCESSFUL = 0 Private Const EWX_FORCE = 4, CCDEVICENAME = 32, CCFORMNAME = 32, DISP_CHANGE_RESTART = 1 Private Const DM_BITSPERPEL = &H40000, DM_PELSWIDTH = &H80000, DM_PELSHEIGHT = &H100000 Private Const WM_DISPLAYCHANGE = &H7E&, HWND_BROADCAST = &HFFFF&, SPI_SETNONCLIENTMETRICS = 42 Private Type DEVMODE 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 'Purpose : Alter the display resolution 'Inputs : lWidth The new screen width ' lHeight The new screen height ' [lBitsPerPixel] The number of colours that you want to use (or the bits per pixel). ' This can be either 4, 6, 8, 16, 24 or 32 depending on the modes supported. 'Outputs : Returns zero on success, -1 if the computer must be restarted for ' the changes to take effect or -2 if the resolution is not supported. 'Author : Andrew Baker 'Date : 24/01/2001 08:41 'Notes : 'Revisions : 'Assumptions : Function ScreenSetResolution(lWidth As Long, lHeight As Long, Optional lBitsPerPixel As Long = -1) As Long Dim lRetVal As Long Dim tDevMode As DEVMODE 'Populate structure with information about the current graphics 'mode on the current display device. lRetVal = EnumDisplaySettings(0, 0, tDevMode) 'Alter the structure with the new resolution details If lBitsPerPixel = -1 Then 'Altering width and height tDevMode.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Else 'Altering width, height and colour tDevMode.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL tDevMode.dmBitsPerPel = lBitsPerPixel End If tDevMode.dmPelsWidth = lWidth tDevMode.dmPelsHeight = lHeight 'Use a test to change the display settings lRetVal = ChangeDisplaySettings(tDevMode, CDS_TEST) Select Case lRetVal Case DISP_CHANGE_SUCCESSFUL 'Successful. Changes can be applied immediately ScreenSetResolution = 0 'Alter resolution Call ChangeDisplaySettings(tDevMode, CDS_UPDATEREGISTRY) 'Send system broadcast to nofity other applications the 'display settings have changed Call SendMessage(HWND_BROADCAST, WM_DISPLAYCHANGE, SPI_SETNONCLIENTMETRICS, ByVal 0&) Case DISP_CHANGE_RESTART 'Successful. Must restart windows for this change to be applied ScreenSetResolution = -1 Case Else 'Mode not supported ScreenSetResolution = -2 End Select End Function 'Demonstration routine Sub Test() Dim lRetVal As Long lRetVal = ScreenSetResolution(1024, 768) Select Case lRetVal Case 0 MsgBox "Successful" Case -1 MsgBox "Successful. Must restart for changes to take effect" Case -2 MsgBox "Failed. Resolution not supported" End Select End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
