Tipp 0076 Bildschirmauflösung auslesen und setzen
Autor/Einsender:
Datum:
  Detlev Schubert
03.06.2001
Entwicklungsumgebung:   VB 5
Gerade für die Spielprogrammierung ohne DirectX kann es notwendig werden, die momentan eingestellte Bildschirmauflösung nicht nur auszulesen, sondern auch neu zu setzen. Dazu wird zunächst mit der API-Funktion EnumDisplaySettings die Datenstruktur vom Typ DEVMODE mit den aktuellen Einstellungen des Bildschirms gefüllt. Liegen diese Daten vor, kann entsprechend der Möglichkeiten der Grafikkarte, die gewünschte Bildschirmauflösung neu gesetzt werden.
 
Option Explicit

Const BITSPIXEL = 12
Const HORZRES = 8
Const VERTRES = 10
Const VREFRESH = 116

Const CCDEVICENAME = 32
Const CCFORMNAME = 32

Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_DISPLAYFREQUENCY = &H400000

Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H2

Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const DISP_CHANGE_FAILED = -1
Const DISP_CHANGE_BADMODE = -2
Const DISP_CHANGE_NOTUPDATED = -3 'Nur NT!

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

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 Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc _
        As Long, ByVal nIndex As Long) As Long

Dim DevM As DEVMODE

Private Sub Form_Load()
  Dim bResult As Boolean, AddString As String
  Dim i As Long

  Do
    bResult = EnumDisplaySettings(0&, i&, DevM)
    If bResult = False Then Exit Do
    AddString = DevM.dmPelsWidth & " x " & DevM.dmPelsHeight & ", "

    If DevM.dmBitsPerPel = 16 Then
      AddString = AddString & "High Color (16 Bit)"
    ElseIf DevM.dmBitsPerPel = 32 Then
      AddString = AddString & "True Color (32 Bit)"
    Else
      AddString = AddString & Format$(2 ^ DevM.dmBitsPerPel, _
                  "#,#") & " Farben"
    End If

    lstSettings.AddItem AddString
    i = i + 1
  Loop
  RefreshInfo
End Sub

Sub RefreshInfo()
  Dim bpp As Long, x As Long, y As Long, freq As Long

  bpp = GetDeviceCaps(Me.hdc, BITSPIXEL)
  x = GetDeviceCaps(Me.hdc, HORZRES)
  y = GetDeviceCaps(Me.hdc, VERTRES)
  freq = GetDeviceCaps(Me.hdc, VREFRESH)
  label1.Caption = "Auflösung: " & x & " x " & y & " Pixel"
  label2.Caption = "Bit pro Pixel: " & bpp & _
        "  (" & Format$(2 ^ bpp, "#,#") & " Farben)"

  If freq > 1 Then
    lblFrequenz = lblFrequenz.Caption & Str$(freq) & " Hz"
  Else
    lblFrequenz.Caption = lblFrequenz.Caption & _
        "(Hardware-Default)"
  End If
End Sub

Private Sub Command1_Click(Index As Integer)
  Select Case Index
    Case 1
      If MsgBox("Möchten Sie die Auflösung wirklich in " & _
              lstSettings.Text & " ändern?", 48 + vbYesNo) = _
              vbYes Then
        EnumDisplaySettings 0&, lstSettings.ListIndex, DevM
        DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or _
                        DM_BITSPERPEL Or DM_DISPLAYFREQUENCY

        Select Case ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
          Case DISP_CHANGE_SUCCESSFUL
            MsgBox "Auflösung erfolgreich geändert.", 64
          Case DISP_CHANGE_RESTART
            MsgBox "Zum Ändern der Auflösung muß der " & _
                   "Computer neu gestartet werden.", 64
          Case DISP_CHANGE_FAILED
            MsgBox "Die Auflösung konnte nicht geändert " & _
                   "werden.", 64
          Case DISP_CHANGE_BADMODE
            MsgBox "Grafikmodus wird nicht unterstützt.", 64
          Case DISP_CHANGE_NOTUPDATED
            MsgBox "Die Einstellungen konnten nicht in der " & _
                   "Registry gespeichert werden.", 64
        End Select

        RefreshInfo
      End If
    Case Else
      Unload Me
      End
  End Select
End Sub
 
Weitere Links zum Thema
Bildschirmauflösung ermitteln

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,3 kB) Downloads bisher: [ 3743 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 16. August 2011