vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: System/Windows · Desktop/Bildschirm/Display   |   VB-Versionen: VB.NET03.09.07
Ermitteln aller möglichen Auflösungen

Ermitteln aller möglichen Auflösungen und Umstellen der Auflösung mittels Code

Autor:   mikeb69Bewertung:     [ Jetzt bewerten ]Views:  10.075 
www.powerdesktop-online.deSystem:  WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Manchmal muss für die Darstellung des eigenen Programmes die Bildschirmauflösung verändert werden. Damit der User das nicht selbst machen muss, brauchen wir eine Funktion die dies erledigt.

Dafür gibt es die beiden API's "EnumDisplaySettings" zur Ermittlung aller möglichen Auflösungen und "ChangeDisplaySettings" zur Umstellung der Auflösung.

Entscheidend für die Ermittlung der Auflösung ist ein korrekter Aufbau der "devMode Structure". Wenn Sie Probleme beim Ermitteln der Auflösungen oder beim Umstellen auf eine andere Auflösung haben, liegt die Ursache wahrscheinlich in der devMode Structure!

Mit nachfolgender Klasse zeige ich, wie alle darstellbaren Auflösungen ermittelt werden können und die Bildschirmauflösung mittels Code umgestellt werden kann.

Verwendete API's:

  • EnumDisplaySettings
  • ChangeDisplaySettings

Klassenmodul

Imports System
Imports System.Runtime
Imports System.Runtime.InteropServices
 
Public Class ClassDisplay
 
  <StructLayout(LayoutKind.Sequential)> _
  Public Structure DEVMODE
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
    Public dmDeviceName As String
    Public dmSpecVersion As Short
    Public dmDriverVersion As Short
    Public dmSize As Short
    Public dmDriverExtra As Short
    Public dmFields As Integer
 
    Public dmOrientation As Short
    Public dmPaperSize As Short
    Public dmPaperLength As Short
    Public dmPaperWidth As Short
 
    Public dmScale As Short
    Public dmCopies As Short
    Public dmDefaultSource As Short
    Public dmPrintQuality As Short
    Public dmColor As Short
    Public dmDuplex As Short
    Public dmYResolution As Short
    Public dmTTOption As Short
    Public dmCollate As Short
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
    Public dmFormName As String
    Public dmLogPixels As Short
    Public dmBitsPerPel As Short
    Public dmPelsWidth As Integer
    Public dmPelsHeight As Integer
 
    Public dmDisplayFlags As Integer
    Public dmDisplayFrequency As Integer
 
    Public dmICMMethod As Integer
    Public dmICMIntent As Integer
    Public dmMediaType As Integer
    Public dmDitherType As Integer
    Public dmReserved1 As Integer
    Public dmReserved2 As Integer
 
    Public dmPanningWidth As Integer
    Public dmPanningHeight As Integer
  End Structure
 
  Private Declare Function EnumDisplaySettings Lib "user32.dll" _
    Alias "EnumDisplaySettingsA" ( _
    ByVal deviceName As String, _
    ByVal modeNum As Integer, _
    ByRef devMode As DEVMODE) As Integer
 
  Private Declare Function ChangeDisplaySettings Lib "user32.dll" _
    Alias "ChangeDisplaySettingsA" ( _
    ByRef devMode As DEVMODE, _
    ByVal flags As Integer) As Integer
 
  ' Struktur, die die Bildschirmauflösung beschreibt
  Public Structure ScreenResolution
    Public Resolution As Size
    Public ColorDeptI As Integer
    Public ColorDeptS As String
    Public Total As String
  End Structure
 
  Private ScreenRes As New List(Of ScreenResolution)
 
  ' dies kann ab .NET 2 einfacher mit Screen.PrimaryScreen.Bounds 
  ' abgefragt werden 
  Private Const ENUM_CURRENT_SETTINGS As Integer = -1
 
  ' entgültige Umstellung der Auflösung
  Private Const CDS_UPDATEREGISTRY As Integer = 1
 
  ' Umstellung der Auflösung testen
  Private Const CDS_TEST As Integer = 2
 
  Private Const DISP_CHANGE_SUCCESSFUL As Integer = 0
  Private Const DISP_CHANGE_RESTART As Integer = 1
  Private Const DISP_CHANGE_FAILED As Integer = -1
 
  Private Const DM_BITSPERPEL = &H40000
  Private Const DM_PELSWIDTH = &H80000
  Private Const DM_PELSHEIGHT = &H100000
  Private Const DM_DISPLAYFREQUENCY = &H400000
 
  ''' <summary>Sub New der ClassDisplay</summary>
  Public Sub New()
    Dim screen As Screen = Windows.Forms.Screen.PrimaryScreen
 
    Dim dm As New DEVMODE()
    dm.dmDeviceName = New String(New Char(31) {})
    dm.dmFormName = New String(New Char(31) {})
    dm.dmSize = CShort(Marshal.SizeOf(dm))
 
    Dim counter As Integer = 0
    Do
      ' Durch Hochzählen des Counter werden alle Auflösungen 
      ' ermittelt, bis 0 zurückgegeben wird.
      ' Wenn Counter als -1 (ENUM_CURRENT_SETTINGS) übergeben wird, 
      ' wird die aktuelle Auflösung ermittelt
      If EnumDisplaySettings(Nothing, counter, dm) <> 0 Then
        ' Farbtiefe
        Dim Colors As String
        Select Case dm.dmBitsPerPel
          Case 4
            Colors = "16 Farben"
          Case 8
            Colors = "256 Farben"
          Case 16
            Colors = "HighColor"
          Case 24
            Colors = "24-Bit"
          Case 32
            Colors = "TrueColor"
          Case Else
            ' was eigentlich nicht sein darf
            Colors = "Keine Farbtiefe gefunden !!!"
        End Select
 
        ' Liste füllen
        Dim sr As New ScreenResolution
        sr.ColorDeptI = dm.dmBitsPerPel
        sr.ColorDeptS = Colors
        sr.Resolution = New Size(dm.dmPelsWidth, dm.dmPelsHeight)
        sr.Total = dm.dmPelsWidth & " x " & dm.dmPelsHeight & " " & Colors
        ScreenRes.Add(sr)
        sr = Nothing
        counter += 1
      Else
        Exit Do
      End If
    Loop
  End Sub
 
#Region "Public Functions/Subs"
  ''' <summary>Stellt die Bildschrimauflösung.</summary>
  ''' <param name="res">Neue Auflösung als Size</param>
  ''' <param name="colorDept">Neue Farbtiefe als Integer</param>
  ''' <returns>True wenn die Umstellung erfolgreich war sonst False</returns>
  Public Function ChangeRes(ByVal res As Size, _
    ByVal colorDept As Integer) As Boolean
 
    ' Struktur für die Übergabe vorbereiten
    Dim dm As New DEVMODE
    dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or _
      DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
    dm.dmPelsHeight = res.Height
    dm.dmPelsWidth = res.Width
    dm.dmBitsPerPel = colorDept
    dm.dmDeviceName = New String(New Char(31) {})
    dm.dmFormName = New String(New Char(31) {})
    dm.dmSize = CShort(Marshal.SizeOf(dm))
    ' Auflösung umstellen
    Dim ret As Integer = ChangeDisplaySettings(dm, CDS_UPDATEREGISTRY)
    Select Case ret
      Case DISP_CHANGE_FAILED
        MessageBox.Show("Die Auflösung konnte nicht verändert werden !!!")
        Return False
      Case DISP_CHANGE_SUCCESSFUL
        Return True
      Case DISP_CHANGE_RESTART
        MessageBox.Show("Zur Umstellung der Auflösung muss das " & _
          "System neu gebootet werden.")
        Return True
      Case Else
        Return False
    End Select
    dm = Nothing
    Return True
  End Function
#End Region
 
#Region "Properties"
  ''' <summary>Gibt eine Liste mit allen möglichen 
  ''' Bildschrimauflösungen zurück.</summary>
  ''' <returns>Bildschirmauflösungen List(Of ScreenResolution)</returns>
  Public ReadOnly Property ScreenResolutions() As List(Of ScreenResolution)
    Get
      Return ScreenRes
    End Get
  End Property
#End Region
End Class

Zum Testen benötigen Sie eine Fom mit 1x Listbox und 2x Button. Über den 1. Button wird die Auflösung anhand des ausgewählten Listen-Eintrags geändert. Beim Klick auf den 2. Button wird die ursprüngliche Auflösung wiederhergestellt.

Public Class Form1
 
  ' Orignal-Auflösung (ursprüngliche Einstellung)
  Private originalRes As Size
 
  ' Verweis auf die Klasse "ClassDisplay"
  Private cd As ClassDisplay
 
  Private Sub Form1_Load(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles MyBase.Load
    ' ursprüngliche (aktuelle) Einstellung
    originalRes = Screen.PrimaryScreen.Bounds.Size
    cd = New ClassDisplay
 
    ' Listbox füllen
    For i As Integer = 0 To cd.ScreenResolutions.Count - 1
      Me.ListBox1.Items.Add(cd.ScreenResolutions(i).Total)
    Next
  End Sub
 
  Private Sub Form1_Shown(ByVal sender As Object, _
    ByVal e As System.EventArgs) Handles Me.Shown
    ' ersten Eintrag der ListBox markieren und Button freigeben, 
    ' falls die Listbox einen Inhalt hat
    If Me.ListBox1.Items.Count > 0 Then
      Me.ListBox1.SelectedIndex = 0
      Me.Button1.Enabled = True
    Else
      Me.Button1.Enabled = False
    End If
  End Sub
 
  Private Sub Button1_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Button1.Click
    ' Auflösung ändern
    Dim temp As String = Me.ListBox1.SelectedItem
    Dim sData() As String = temp.Split(" ")
    Select Case sData(3).ToLower
      Case "highcolor"
        sData(3) = "16"
      Case "truecolor"
        sData(3) = "32"
      Case "256"
        sData(3) = "8"
      Case 16
        sData(3) = "4"
    End Select
    cd.ChangeRes(New Size(Val(sData(0)), Val(sData(2))), Val(sData(3)))
  End Sub
 
  Private Sub Button2_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles Button2.Click
    ' ursprüngliche Auflösung wiederherstellen
    cd.ChangeRes(originalRes, 32)
  End Sub
End Class

Dieser Tipp wurde bereits 10.075 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.

Neue Diskussion eröffnen

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-2024 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