Screen_Module

'Change Resolution
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


'Print Screen
Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'
'Color Depth
Private Const PLANES& = 14
Private Const BITSPIXEL& = 12
Private Declare Function GetDeviceCaps& Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long)
Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)

Function GetScreenResX() As Long
Dim X As Integer
X = Screen.Width / 15
'y = Screen.Height / 15
GetScreenResX = X
End Function

Function GetScreenResY() As Long
Dim Y As Integer
'X = Screen.Width / 15
Y = Screen.Height / 15
GetScreenResY = Y
End Function

Function Print_Screen()
keybd_event vbKeySnapshot, 0, 0, 0
End Function

Function GetColorDepth() As Integer
Dim nPlanes As Integer, BitsPerPixel As Integer, dc As Long
dc = GetDC(0)
nPlanes = GetDeviceCaps(dc, PLANES)
BitsPerPixel = GetDeviceCaps(dc, BITSPIXEL)
ReleaseDC 0, dc
GetColorDepth = nPlanes * BitsPerPixel
End Function

Function Change_Res_To_640_480() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 640 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 480 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_640_480 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_640_480 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_800_600() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 800 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 600 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_800_600 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_800_600 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1024_768() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1024 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1024_768 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1024_768 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1280_600() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1280 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 600 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1280_600 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1280_600 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1280_720() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1280 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 720 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1280_720 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1280_720 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1280_768() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1280 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1280_768 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1280_768 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1360_768() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1360 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1360_768 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1360_768 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function

Function Change_Res_To_1366_768() As String
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = 1366 'ÇÎÊÑ ÇáÚÑÖ (640,800,1024, etc)
.dmPelsHeight = 768 'ÇÎÊÑ ÇáØæá (480,600,768, etc)
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & vbCrLf & _
vbCrLf & "Do you want to restart now?", vbYesNo + vbSystemModal, _
"Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Change_Res_To_1366_768 = "Screen resolution changed" ', vbInformation, "Resolution Changed"
Case Else
Change_Res_To_1366_768 = "Mode not supported" ', vbSystemModal, "Error"
End Select
End Function