vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Top-Preis! AP-Access-Tools-CD Volume 1  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: System/Windows · Desktop/Bildschirm/Display   |   VB-Versionen: VB4, VB5, VB607.06.01
Bildschirm-Einstellungen ermitteln und ändern

Routinen zum Ermitteln aller unterstützen Bildschirm-Einstellungen, sowie zum Ändern der aktuellen Einstellung.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  46.638 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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.
 

Dieser Tipp wurde bereits 46.638 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (1 Beitrag)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel