Bildschirm-Einstellungen ermitteln und ändern Routinen zum Ermitteln aller unterstützen Bildschirm-Einstellungen, sowie zum Ändern der aktuellen Einstellung.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  52.169
www.tools4vb.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 68 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Welche Bildschirmauflösungen bei welcher Farbtiefe und welchen Frequenzen werden von Windows für Ihren Monitor (Ihre Grafikkarte) unterstützt?

Das Windows-API stellt uns hierfür ein paar "nette" Funktionen zur Verfügung. Über die API-Funktion EnumDisplaySettings lassen sich alle unterstützen Bidlschirm-Einstellungen ermitteln. Diese können dann z.B. in einer Listbox angezeigt werden, so daß man bequem eine neue Einstellung auswählen kann. Hat man nun eine neue Einstellung selektiert, kann über die ChangeDisplaySettings-Funktion diese Einstellung als neue Standard-Einstellung gesetzt werden. Anhand des Funktions-Rückgabewertes lässt sich dann sogar abfragen, ob für das Ändern der Bildschirm-Einstellungen ein Neustart des System erforderlich ist, so daß der Neustart ggf. dann programmgesteuert ausgeführt werden kann.

Und jetzt die berühmte Frage: "Wozu das ganze?"

Na ja, nehmen wir an, für einen reibungslosen Ablauf benötigt Ihr Programm eine eingestellte Mindestauflösung von 800x600 Punkten bei einer Farbtiefe von mind. 16-Bit (TrueColor). Beim Programmaufruf prüfen Sie dann einfach die aktuellen Bildschirm-Einstellungen. Entsprechen diese nicht den Mindestanforderungen, so prüfen Sie, ob die Mindestanforderungen überhaupt vom System her unterstützt werden. Konnte eine entsprechende Einstellung gefunden werden, so zeigen Sie einen Hinweis, daß jetzt auf diese Einstellungen umgestellt wird...

' zunächst die benötigten API-Deklarationen
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hdc As Long, _
  ByVal nIndex As Long) As Long
 
Private Declare Function EnumDisplaySettings Lib "user32" _
  Alias "EnumDisplaySettingsA" ( _
  ByVal lpszDeviceName As Long, _
  ByVal iModeNum As Long, _
  lpDevMode As Any) As Boolean
 
Private Declare Function ChangeDisplaySettings Lib "user32" _
  Alias "ChangeDisplaySettingsA" ( _
  lpDevMode As Any, _
  ByVal dwFlags As Long) As Long
 
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const DM_DISPLAYFREQUENCY = &H400000
 
Private Const CDS_UPDATEREGISTRY = &H1
Private Const CDS_TEST = &H2
 
Private Const DISP_CHANGE_SUCCESSFUL = 0
Private Const DISP_CHANGE_RESTART = 1
Private Const DISP_CHANGE_FAILED = -1
Private Const DISP_CHANGE_BADMODE = -2
Private Const DISP_CHANGE_NOTUPDATED = -3 ' Nur NT!
 
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const BITSPIXEL = 12
 
Private 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

Aktuelle Bildschirm-Einstellungen ermitteln

' aktuelle Bildschirm-Einstellungen ermitteln
' x, y = Auflösung
' Colors = Farbtiefe (4,8,16,24,32)
Public Sub GetCurrentSettings(ByVal hDC As Long, _
  x As Integer, y As Integer, Colors As Integer)
 
  x = Screen.Width / Screen.TwipsPerPixelX
  y = Screen.Height / Screen.TwipsPerPixelY
  Colors = GetDeviceCaps(hDC, BITSPIXEL)
End Sub

Ändern der Auflösung und der eingestellten Farbtiefe

' neue Bildschirm-Einstellung setzen
' x,y = neue Auflösung
' Colors = neue Farbtiefe
'      4 =  16 Farben
'      8 = 256 Farben
'     16 = HighColor
'     24 = 24-Bit
'     32 = TrueColor
Public Sub ChangeSettings(ByVal hDC As Long, _
  x As Integer, y As Integer, Colors As Integer)
 
  Dim lResult As Long
  Dim lIndex As Long
  Dim DevM As DEVMODE
 
  With DevM
    .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or _
      DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
    .dmPelsWidth = x
    .dmPelsHeight = y
    .dmBitsPerPel = Colors
  End With
  lResult = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
  Select Case lResult
    Case DISP_CHANGE_RESTART
      If MsgBox("Damit die eingestellte Auflösung " & _
        "wirksam wird, ist es notwendig, daß Windows " & _
        "neu gestartet wird.", 65) = vbOK Then
        RebootSystem EWX_REBOOT
      End If
    Case DISP_CHANGE_FAILED
      MsgBox "Die Auflösung konnte nicht " & _
        "geändert werden.", 64
    Case DISP_CHANGE_BADMODE
      MsgBox "Der geforderte Grafikmodus wird " & _
        "von Ihrem System nicht unterstützt.", 64
    Case DISP_CHANGE_NOTUPDATED
      MsgBox "Die neuen Einstellungen konnten " & _
        "nicht in der Registry gespeichert werden.", 64
  End Select
End Sub

So mit den obigen Routinen lässt sich doch schon mal einiges anfangen. Um nun beim Programmstart die Mindestanforderungen zu prüfen und ggf. die Einstellungen zu ändern, hier ein Beispiel:

' Prüfen der Einstellungen
Private Sub Form_Load()
  Dim x As Integer
  Dim y As Integer
  Dim Colors As Integer
 
  ' Ermitteln der aktuellen Einstellungen
  GetCurrentSettings Me.hDC, x, y, Colors
 
  ' Mindestanforderung:
  ' 800x600 bei 16bit Farbtiefe (TrueColor)
  If x < 800 Or y < 600 Or Colors < 16 Then
    ' Mindestanforderung nicht erfüllt
    If MsgBox("Für den korrekten Ablauf der " & _
      "Anwendung muß eine Bildschirm-Auflösung " & _
      "von mind. 800x600 bei einer Farbtiefe von " & _
      "16Bit (TrueColor) eingestellt sein!" & _
      vbCrLf & vbCrLf & _
      "Einstellungen entsprechend ändern?", _
      35) = vbYes Then
      ' Einstellung ändern
        ChangeSettings Me.hDC, 800, 600, 16
    Else
      ' Programm beenden
      End
    End If
  End If
End Sub

Weiteres Beispiel
Und nun zum eingang erwähnten Beispiel, bei welchem alle vom System unterstützten Bildschirm-Einstellungen in einer Liste angezeigt werden sollen. Per Doppelklick auf einen Listen-Eintrag sollen die Einstellungen dann entsprechend neu gesetzt werden.

Um das nachfolgende Beispiel ausprobieren zu können, starten Sie ein neues Projekt, plazieren auf die Form eine ListBox List1 und fügen im Allgemein-Teil der Form1 alle notwendigen API-Deklarationen ein (siehe ganz vorne).

' Alle unterstützen Bildschirm-Modi ermitteln
Public Sub GetAllScreenModes(List As ListBox)
  Dim lResult As Long
  Dim i As Long
  Dim DevM As DEVMODE
  Dim Res As String
  Dim Colors As String
 
  ' Liste aller unterstützen Device-Modi erstellen
  List.Clear
  i = 0
  Do
    lResult = EnumDisplaySettings(0&, i, DevM)
    If lResult = 0 Then Exit Do
 
    With DevM
      ' Auflösung
      Res = .dmPelsWidth & " x " & .dmPelsHeight
 
      ' Farbtiefe
      If .dmBitsPerPel = 4 Then
        Colors = "16 Farben"
      ElseIf .dmBitsPerPel = 8 Then
        Colors = "256 Farben"
      ElseIf .dmBitsPerPel = 16 Then
        Colors = "HighColor"
      ElseIf .dmBitsPerPel = 24 Then
        Colors = "24-Bit"
      ElseIf .dmBitsPerPel = 32 Then
        Colors = "TrueColor"
      End If
 
      List.AddItem Format$(i, "0") & " - " & Res & _
        ", " & Colors & " (" & .dmDisplayFrequency & _
        " Hz)"
    End With
    i = i + 1
  Loop
End Sub
 
' Beim Laden der Form, Liste füllen
Private Sub Form_Load()
  GetAllScreenModes List1
End Sub
 
' Einstellungen ändern
Private Sub List1_Click()
  Dim lResult As Long
  Dim lIndex As Long
  Dim DevM As DEVMODE
 
  lIndex = List1.ListIndex
  lResult = EnumDisplaySettings(0&, lIndex, DevM)
  If lResult = 0 Then Exit Sub
 
  ' Mitteilen, welche Einstellungen geändert werden
  ' sollen (Auflösung + Farbtiefe + Frequenz)
  With DevM
    .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or _
      DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
  End With
 
  lResult = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
  Select Case lResult
    Case DISP_CHANGE_RESTART
      If MsgBox("Damit die eingestellte Auflösung " & _
        "wirksam wird, ist es notwendig, daß Windows " & _
        "neu gestartet wird.", 65) = vbOK Then
        RebootSystem EWX_REBOOT
      End If
    Case DISP_CHANGE_FAILED
      MsgBox "Die Auflösung konnte nicht " & _
        "geändert werden.", 64
    Case DISP_CHANGE_BADMODE
      MsgBox "Der geforderte Grafikmodus wird " & _
        "von Ihrem System nicht unterstützt.", 64
    Case DISP_CHANGE_NOTUPDATED
      MsgBox "Die neuen Einstellungen konnten " & _
        "nicht in der Registry gespeichert werden.", 64
  End Select
End Sub

Innerhalb der beiden Beispiele wird - wenn ein Neustart des Systems erforderlich ist - die Prozedur RebootSystem aufgerufen. Hierbei handelt es sich um keine API-Funktion oder einem Standard Visual-Basic Befehl, sondern um einen eigenständigen Tipp im vb@rchiv. Die Prozedur RebootSystem finden Sie im Bereich Extra-Tipps.