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.
Verwendete 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