Visual Basic Enumeration/Callback Routines
EnumDisplaySettings: Enumerate Available Display Resolutions
     
Posted:   Tuesday September 11, 1998
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB5, Windows 98
OS restrictions:   None
Author:   Joe LeVasseur
     

Related:  

ChangeDisplaySettings: Change Display Resolution
EnumDisplaySettings: Enumerate Available Display Resolutions
EnumDisplayDevices: Enumerating System Display Devices

EnumDisplayMonitors: Enumerating System Monitor Info
       
 Prerequisites
None.

EnumDisplaySettings: Enumerate Available Display Resolutions(9890 bytes)This routine uses Windows' EnumDisplaySettings API to retrieve all the available screen resolutions supported by the display. The results are populated to a ListView showing colour depths, resolutions and frequencies supported. In addition, the current system resolution is determined and flagged.
 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function EnumDisplaySettings Lib "user32" _
    Alias "EnumDisplaySettingsA" _
   (ByVal lpszDeviceName As Long, _
    ByVal iModeNum As Long, _
    lpDevMode As Any) As Long
          
Public Declare Function GetDeviceCaps Lib "gdi32" _
   (ByVal hdc As Long, _
    ByVal nIndex As Long) As Long
   
Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
   
Public Const LVS_EX_FULLROWSELECT As Long = &H20
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE As Long = (LVM_FIRST + 54)

Public Const LOGPIXELSX As Long = 88
Public Const LOGPIXELSY As Long = 90
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 Const DM_DISPLAYFLAGS As Long = &H200000

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
 Form Code
Add a listview (LV) and a command button to a form. To the listview, add five column headers as indicated, and set the style to report mode. Add the following to the form:

Option Explicit

'vars set in load
Dim currHRes As Long
Dim currVRes As Long
Dim currBPP As Long
   
Private Sub Form_Load()

  'set the extended listview style
   Call SendMessage(LV.hWnd, _
                    LVM_SETEXTENDEDLISTVIEWSTYLE, _
                    LVS_EX_FULLROWSELECT, ByVal True)
  
  'retrieve the current screen resolution for
  'later comparison against DEVMODE values in
  'CompareSettings().
   currHRes = GetDeviceCaps(hdc, HORZRES)
   currVRes = GetDeviceCaps(hdc, VERTRES)
   currBPP = GetDeviceCaps(hdc, BITSPIXEL)
         
End Sub


Private Sub LVAdd(DM As DEVMODE)
 
   Dim itmX As ListItem
   Dim bppType As String
   
   Select Case DM.dmBitsPerPel
      Case 4:      bppType = "16 Color"
      Case 8:      bppType = "256 Color"
      Case 16:     bppType = "High Color"
      Case 24, 32: bppType = "True Color"
   End Select
   
   Set itmX = LV.ListItems.Add(, , bppType)
  
   itmX.SubItems(1) = Format$(DM.dmPelsWidth, " 000 x") & _
                      Format$(DM.dmPelsHeight, " 000")
                      
   itmX.SubItems(2) = Format$(DM.dmBitsPerPel, " 00")
   
   If DM.dmDisplayFrequency = 1 Then
      itmX.SubItems(3) = "Hardware default"
   Else
      itmX.SubItems(3) = Format$(DM.dmDisplayFrequency, " 00") & " hz"
   End If
   
   If CompareSettings(DM) Then
     itmX.SubItems(4) = "Current"
     itmX.Selected = True
   End If
   
End Sub


Private Function CompareSettings(DM As DEVMODE) As Boolean
   
  'compares the current screen resolution with
  'the current DEVMODE values. Returns TRUE if
  'the horizontal and vertical resolutions, and
  'the bits per pixel colour depth, are the same.
  
   CompareSettings = (DM.dmBitsPerPel = currBPP) And _
                      DM.dmPelsHeight = currVRes And _
                      DM.dmPelsWidth = currHRes
   
End Function


Private Sub Command1_Click()

   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
      If DM.dmBitsPerPel >= 4 Then Call LVAdd(DM)
      
     'increment and call again. Continue until
     'EnumDisplaySettings returns 0 (no more settings)
      dMode = dMode + 1
   
   Loop
   
End Sub


Private Sub LV_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)

  LV.SortKey = ColumnHeader.Index - 1
  LV.SortOrder = Abs(Not LV.SortOrder = 1)
  LV.Sorted = True
  
End Sub
 Comments
After running the app, the listview will contain a list of the available resolutions for that system, and the present resolution setting will be highlighted. (Make sure that the Listview's HideSelection property is false.)

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter