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

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