by Michael Wong (1 Submission)
Category: Windows API Call/Explanation
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Sun 14th February 1999
Date Added: Mon 8th February 2021
Rating: (1 Votes)
Enum the supported display resolutions, change resolution and detect the display change message from Windows.
API Declarations
Public Const WM_DISPLAYCHANGE = &H7E
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Public Const DISP_CHANGE_FAILED = -1
Public Const DISP_CHANGE_BADMODE = -2
Public Const DISP_CHANGE_NOTUPDATED = -3
Public Const DISP_CHANGE_BADFLAGS = -4
Public Const DISP_CHANGE_BADPARAM = -5
Public Const CDS_UPDATEREGISTRY = 1
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSHEIGHT = &H100000
Public Const DM_PELSWIDTH = &H80000
Public Type DevMode
dmDeviceName As String * 32
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 * 32
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' Windows 95 only
dmICMIntent As Long ' Windows 95 only
dmMediaType As Long ' Windows 95 only
dmDitherType As Long ' Windows 95 only
dmICCManufacturer As Long ' Windows 95 only
dmICCModel As Long ' Windows 95 only
dmPanningWidth As Long ' Windows 95 only
dmPanningHeight As Long ' Windows 95 only
End Type
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As DevMode, ByVal dwFlags As Long) As Long
Public Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, lpDevMode As DevMode) As Long
'Procedure for Enum the supported resolutions
Private Sub EnumRes()
Dim utDevMode As DevMode, fEnd As Boolean
Dim sDeviceName As String, iMode As Long
Dim oItem As New ListItem
utDevMode.dmSize = Len(utDevMode)
iMode = 0
Do
fEnd = EnumDisplaySettings(sDeviceName, iMode, utDevMode)
'Do sth with the utDevMode structure
'The fields dmPelsWidth, dmPelsHeight, dmBitsPerPel are most useful
iMode = iMode + 1
Loop Until Not fEnd
End Sub
'Code for changing display resolution
Private Sub ChangeIt(lPelsWidth As Long, lPelsHeight As Long, lBitsPerPel As Long)
Dim utDevMode As DevMode
Dim iRes As Long
Dim sMsg As String
Dim oItem As ListItem
If lvSettings.SelectedItem Is Nothing Then Exit Sub
With utDevMode
.dmSize = Len(utDevMode)
.dmPelsWidth = lPelsWidth
.dmPelsHeight = lPelsHeight
.dmBitsPerPel = lBitsPerPel
.dmFields = DM_BITSPERPEL Or DM_PELSHEIGHT Or DM_PELSWIDTH
End With
iRes = ChangeDisplaySettings(utDevMode, CDS_UPDATEREGISTRY)
Select Case iRes
Case Is = DISP_CHANGE_SUCCESSFUL
sMsg = "Display setting has been changed successfully."
Case Is = DISP_CHANGE_RESTART
sMsg = "You have to restart your computer in order to carry out the new setting."
Case Is = DISP_CHANGE_FAILED
sMsg = "Sorry, failed to change the display setting."
End Select
If sMsg <> vbNullString Then MsgBox sMsg, , "Display"
End Sub
'To detect the change notification of display resolution
'from Windows, put the code below into a module, except
'Hook & Unhook in a form.
'To begin to capture the notification, call Hook
'To end capturing the notification, call Unhook
Public lPreWndProc As Long
Public Type TLoHiLong
lo As Integer
hi As Integer
End Type
Public Type TAllLong
all As Long
End Type
'Procedure for Subclassing
Public Function MyWndProc _
(ByVal hwnd As Long, _
ByVal lMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If lMsg = WM_DISPLAYCHANGE Then
Debug.Print "DisplayChange"
Debug.Print "BitsPerPel: ", wParam
Debug.Print "lParam: ", lParam
Debug.Print "loword of lParam: ", LoWord(lParam)
Debug.Print "HiWord of lParam: ", HiWord(lParam)
End If
MyWndProc = CallWindowProc(lPreWndProc, hwnd, lMsg, wParam, lParam)
End Function
Public Function LoWord(dw As Long) As Integer
Dim lohi As TLoHiLong
Dim all As TAllLong
all.all = dw
LSet lohi = all
LoWord = lohi.lo
End Function
Public Function HiWord(dw As Long) As Integer
Dim lohi As TLoHiLong
Dim all As TAllLong
all.all = dw
LSet lohi = all
HiWord = lohi.hi
End Function
'Code for Subclassing
Private Sub Hook()
lPreWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf MyWndProc)
End Sub
Private Sub Unhook()
Call SetWindowLong(Me.hwnd, GWL_WNDPROC, lPreWndProc)
End Sub
'Note:
' The HiWord & LoWord functions are from
' the book Hardcore Visual Basic by
' B.Mckinney, Microsoft PRESS
No comments have been posted about Enum the supported display resolutions, change resolution and detect the display change message fro. Why not be the first to post a comment about Enum the supported display resolutions, change resolution and detect the display change message fro.