Happy Codings - Programming Code Examples
Html Css Web Design Sample Codes CPlusPlus Programming Sample Codes JavaScript Programming Sample Codes C Programming Sample Codes CSharp Programming Sample Codes Java Programming Sample Codes Php Programming Sample Codes Visual Basic Programming Sample Codes


Visual Basic Programming Code Examples

Visual Basic > Graphics Games Programming Code Examples

Changing the screen resolution-colors

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
Changing the screen resolution-colors 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. '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