Tipp 5.13 - Alle Auflösungen

Wie kann ich eine Liste aller möglichen Auflösungen ermitteln?

Mit dieser Funktion können Sie eine Liste aller möglichen Auflösungen ermitteln. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: EnumDisplaySettings - DEVMODE, DisplayResolution_t

Beispiel:

Option Explicit
 
Public Const CCDEVICENAME       As Long = 32
Public Const CCFORMNAME         As Long = 32
 
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 DisplayResolution_t
  lBitsPerPixel       As Long
  lWidth              As Long
  lHeight             As Long
  lFrequency          As Long
  sColourDepth        As String
  sResolution         As String
  sFrequency          As String
End Type
 
Public Declare Function EnumDisplaySettings _
    Lib "user32" Alias _
    "EnumDisplaySettingsA" _
    (ByVal lpszDeviceName As Long, _
    ByVal iModeNum As Long, _
    lpDevMode As Any) As Boolean
 
Public Function GetResolutionList( _
                uSettings() As DisplayResolution_t) As Long
  '// -----------------------------------------------------
  '// Methode:   | Liste aller möglichen Auflösungen
  '//            | ermitteln
  '// -----------------------------------------------------
  '// Parameter: | uSettings Struktur-Array vom Typ
  '//            | DisplayResolution_t
  '// -----------------------------------------------------
  '// Rückgabe:  | s.o.
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel:
  '// -----------------------------------------------------
  '// Dim lResult     As Long
  '// Dim lCount      As Long
  '// Dim uSettings() As DisplayResolution_t
  '// lResult = GetResolutionList(uSettings)
  '// If lResult > 0 Then
  '//     For lCount = 0 To lResult - 1
  '//         With uSettings(lCount)
  '//             Debug.Print .sColourDepth; vbTab; _
  '//                         .sResolution; vbTab; _
  '//                         .sFrequency
  '//         End With
  '//     Next
  '//     Erase uSettings
  '// End If
  '// -----------------------------------------------------
  Const DM_PELSWIDTH  As Long = &H80000
  Const DM_PELSHEIGHT As Long = &H100000
  Const DM_BITSPERPEL As Long = &H40000
 
  Dim uDevMode        As DEVMODE
  Dim lCount          As Long
  Dim dMode           As Long
 
  uDevMode.dmFields = DM_PELSWIDTH Or _
      DM_PELSHEIGHT Or DM_BITSPERPEL
  uDevMode.dmSize = LenB(uDevMode)
 
  dMode = 0
  lCount = 0
  Do While EnumDisplaySettings(0&, dMode, uDevMode) > 0
    If uDevMode.dmBitsPerPel >= 4 Then
      lCount = lCount + 1
      ReDim Preserve uSettings(lCount)
      With uSettings(lCount - 1)
        Select Case uDevMode.dmBitsPerPel
        Case 4:
          .sColourDepth = "16 Farben"
        Case 8:
          .sColourDepth = "256 Farben"
        Case 15:
          .sColourDepth = "High Color (15-Bit)"
        Case 16:
          .sColourDepth = "High Color (16-Bit)"
        Case 24:
          .sColourDepth = "True Color (24-Bit)"
        Case 32:
          .sColourDepth = "True Color (32-Bit)"
        Case Else:
          .sColourDepth = CStr((2 ^ uDevMode.dmBitsPerPel) _
              & " Farben")
        End Select
        .lBitsPerPixel = uDevMode.dmBitsPerPel
        .lFrequency = uDevMode.dmDisplayFrequency
        .lHeight = uDevMode.dmPelsHeight
        .lWidth = uDevMode.dmPelsWidth
        .sResolution = Format$(uDevMode.dmPelsWidth, _
            " 000 x") & _
            Format$(uDevMode.dmPelsHeight, " 000")
        If uDevMode.dmDisplayFrequency = 1 Then
          .sFrequency = "Hardware default"
        Else: .sFrequency = _
            Format$(uDevMode.dmDisplayFrequency, _
            " 00") & " Hz"
        End If
      End With
    End If
    dMode = dMode + 1
  Loop
  GetResolutionList = lCount
 
End Function