Finding out about the user's display modes

Use the EnumDisplaySettings to retrieve a DEVMODE structure about display modes. I have written these wrapping functions to find all of the display modes. These are returned from the function in a custom DevModeHolder type, which you can then pass to the GetCurDispMode to retrieve the current display mode. Here are the functions:

Declarations

Public Declare Function ChangeDisplaySettings Lib _
"user32" Alias "ChangeDisplaySettingsA" (lpDevMode As _
Any, ByVal dwflags As Long) As Long

Public Declare Function EnumDisplaySettings Lib _
"user32" Alias "EnumDisplaySettingsA" (ByVal _
lpszDeviceName As Long, ByVal iModeNum As Long, _
lpDevMode As Any) As Boolean

Public Declare Function GetDeviceCaps Lib _
"gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Public Const CDS_FORCE As Long = &H80000000

Public Const BITSPIXEL As Long = 12
Public Const HORZRES As Long = 8
Public Const VERTRES As Long = 10

Public Const CCDEVICENAME As Long = 32
Public Const CCFORMNAME As Long = 32

Public Const DM_BITSPERPEL As Long = &H40000
Public Const DM_PELSWIDTH As Long = &H80000
Public Const DM_PELSHEIGHT As Long = &H100000

Public 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

Public Type DevModeHolder
DevModes() As DEVMODE
End Type

Functions

Copy the following code into the module.

Public Function GetAllDispModes() As DevModeHolder
Dim AllDispModes As DevModeHolder

Dim DM As DEVMODE
Dim dMode As Long
Dim r As Long

'set the DEVMODE flags and structure size
DM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DM.dmSize = LenB(DM)

'The first mode is 0
dMode = 0

Do While EnumDisplaySettings(0&, dMode, DM) > 0

'if the BitsPerPixel is greater than 4
'(16 colours), then add the item to the list
ReDim Preserve AllDispModes.DevModes(dMode) As DEVMODE
AllDispModes.DevModes(dMode) = DM
'increment and call again. Continue until
'EnumDisplaySettings returns 0 (no more settings)
dMode = dMode + 1

Loop

GetAllDispModes = AllDispModes

End Function

Public Function GetCurDispMode(AllDispModes As _
DevModeHolder, hDC As Long) As Integer
Dim currHRes As Long
Dim currVRes As Long
Dim currBPP As Long
Dim CheckDM As Integer

currHRes = GetDeviceCaps(hDC, HORZRES)
currVRes = GetDeviceCaps(hDC, VERTRES)
currBPP = GetDeviceCaps(hDC, BITSPIXEL)

For CheckDM = 0 To UBound(AllDispModes.DevModes)
If AllDispModes.DevModes(CheckDM).dmBitsPerPel = _
currBPP And AllDispModes.DevModes(CheckDM).dmPelsHeight = _
currVRes And AllDispModes.DevModes(CheckDM).dmPelsWidth = _
currHRes Then
GetCurDispMode = CheckDM
Exit Function
End If
Next

CheckDM = 0
End Function

Public Sub SetCurDispMode(NewDM As DEVMODE)

ChangeDisplaySettings NewDM, CDS_FORCE

End Sub

Use

Use the code as follows:

Dim AllDispModes As DevModeHolder
Dim curmode As Integer
Dim i As Variant
Dim bpptype As String

AllDispModes = GetAllDispModes
curmode = GetCurDispMode(AllDispModes, hDC)

For i = 0 To UBound(AllDispModes.DevModes)
Select Case AllDispModes.DevModes(i).dmBitsPerPel
Case 4: bpptype = "16 Color"
Case 8: bpptype = "256 Color"
Case 16: bpptype = "High Color"
Case 24, 32: bpptype = "True Color"
End Select

Debug.Print bpptype, Format$(AllDispModes.DevModes(i).dmPelsWidth, _
" 000 x") & Format$(AllDispModes.DevModes(i).dmPelsHeight, " 000"), _
Format$(AllDispModes.DevModes(i).dmBitsPerPel, " 00"), IIf(i = _
curmode, "Current", "")
Next
End

Then to set the mode:

SetCurDispMode AllDispModes.DevModes(5)