Alle Bildschirmauflösungen ermitteln und wechseln

    • VB.NET

    Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von ErfinderDesRades.

      Alle Bildschirmauflösungen ermitteln und wechseln

      Hallo,

      diesen Tipp hab ich 2007 auf meiner alten Homepage veröffentlicht.
      Da es die Seite nicht mehr gibt, setz ich ihn jetzt hier rein.

      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 bzw. ChangeDisplaySettingsEx zur Umstellung der Auflösung.
      Entscheidend für 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, wird Ihr Problem wahrscheinlich in der devMode Structure liegen !!!

      Hier nun meine Klasse

      VB.NET-Quellcode

      1. Imports System
      2. Imports System.RuntimeImports
      3. System.Runtime.InteropServices
      4. Class ClassDisplay
      5. <StructLayout(LayoutKind.Sequential)> _
      6. Public Structure DEVMODE
      7. <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
      8. Public dmDeviceName As String
      9. Public dmSpecVersion As Short
      10. Public dmDriverVersion As Short
      11. Public dmSize As Short
      12. Public dmDriverExtra As Short
      13. Public dmFields As Integer
      14. Public dmOrientation As Short
      15. Public dmPaperSize As Short
      16. Public dmPaperLength As Short
      17. Public dmPaperWidth As Short
      18. Public dmScale As Short
      19. Public dmCopies As Short
      20. Public dmDefaultSource As Short
      21. Public dmPrintQuality As Short
      22. Public dmColor As Short
      23. Public dmDuplex As Short
      24. Public dmYResolution As Short
      25. Public dmTTOption As Short
      26. Public dmCollate As Short
      27. <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=32)> _
      28. Public dmFormName As String
      29. Public dmLogPixels As Short
      30. Public dmBitsPerPel As Short
      31. Public dmPelsWidth As Integer
      32. Public dmPelsHeight As Integer
      33. Public dmDisplayFlags As Integer
      34. Public dmDisplayFrequency As Integer
      35. Public dmICMMethod As Integer
      36. Public dmICMIntent As Integer
      37. Public dmMediaType As Integer
      38. Public dmDitherType As Integer
      39. Public dmReserved1 As Integer
      40. Public dmReserved2 As Integer
      41. Public dmPanningWidth As Integer
      42. Public dmPanningHeight As Integer
      43. End Structure
      45. Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" _
      46. (ByVal deviceName As String, ByVal modeNum As Integer, _ ByRef devMode As DEVMODE) As Integer
      47. Private Declare Function ChangeDisplaySettingsEx Lib "user32.dll" Alias "ChangeDisplaySettingsExA" _
      48. (ByVal lpszDeviceName As String, _ ByRef lpDevMode As DEVMODE, ByVal hwnd As Int32, _
      49. ByVal dwflags As Int32, ByVal lParam As Int32) As Int32
      50. 'Struktur die die Bildschirmauflösung beschreibt
      51. Public Structure ScreenResolution
      52. Public Resolution As Size
      53. Public ColorDeptI As Integer
      54. Public ColorDeptS As String
      55. Public Total As String
      56. End Structure
      58. Private ScreenRes As New List(Of ScreenResolution)
      59. Private deviceName As String 'dies kann ab .net 2 einfacher mit Screen.PrimaryScreen.Bounds abfegragt werden
      60. Private Const ENUM_CURRENT_SETTINGS As Integer = -1
      61. Private Const CDS_UPDATEREGISTRY As Integer = 1 'entgültige umstellung der auflösung
      62. Private Const CDS_TEST As Integer = 2 'umstellung der auflösung testen
      63. Private Const DISP_CHANGE_SUCCESSFUL As Integer = 0
      64. Private Const DISP_CHANGE_RESTART As Integer = 1
      65. Private Const DISP_CHANGE_FAILED As Integer = -1
      66. Private Const DM_BITSPERPEL = &H40000
      67. Private Const DM_PELSWIDTH = &H80000
      68. Private Const DM_PELSHEIGHT = &H100000
      69. Private Const DM_DISPLAYFREQUENCY = &H400000
      71. ''' <summary>Sub New der ClassDisplay</summary>
      72. ''' <param name="devName">DeviceName des gewählten Bildschirmes.</param>
      73. Public Sub New(ByVal devName As String)
      74. deviceName = devName
      75. Dim dm As New DEVMODE()
      76. dm.dmDeviceName = New String(New Char(31) {})
      77. dm.dmFormName = New String(New Char(31) {})
      78. dm.dmSize = CShort(Marshal.SizeOf(dm))
      79. Dim counter As Integer = 0
      80. Do
      81. '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
      82. If EnumDisplaySettings(deviceName, counter, dm) <> 0 Then ' Farbtiefe
      83. Dim Colors As String
      84. Select Case dm.dmBitsPerPel
      85. Case 4
      86. Colors = "16 Farben"
      87. Case 8
      88. Colors = "256 Farben"
      89. Case 16
      90. Colors = "HighColor"
      91. Case 24
      92. Colors = "24-Bit"
      93. Case 32
      94. Colors = "TrueColor"
      95. Case Else
      96. 'was eigentlich nicht sein darf
      97. Colors = "Keine Farbtiefe gefunden !!!"
      98. End Select
      99. 'liste füllen
      100. Dim sr As New ScreenResolution
      101. sr.ColorDeptI = dm.dmBitsPerPel
      102. sr.ColorDeptS = Colors
      103. sr.Resolution = New Size(dm.dmPelsWidth, dm.dmPelsHeight)
      104. sr.Total = dm.dmPelsWidth & " x " & dm.dmPelsHeight & " " & Colors ScreenRes.Add(sr)
      105. sr = Nothing
      106. counter += 1
      107. Else
      108. Exit Do
      109. End If
      110. Loop
      111. End Sub
      113. #Region "Public Functions/Subs"
      114. ''' <summary>Stellt die Bildschrimauflösung.</summary>
      115. ''' <param name="res">Neue Auflösung als Size</param>
      116. ''' <param name="colorDept">Neue Farbtiefe als Integer</param>
      117. ''' <returns>True wenn die Umstellung erfolgreich war sonst False</returns>
      118. Public Function ChangeRes(ByVal res As Size, ByVal colorDept As Integer) As Boolean
      119. 'Struktur für die Übergabe vorbereiten
      120. Dim dm As New DEVMODE
      121. dm.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL Or DM_DISPLAYFREQUENCY
      122. dm.dmPelsHeight = res.Height
      123. dm.dmPelsWidth = res.Width
      124. dm.dmBitsPerPel = colorDept
      125. dm.dmDeviceName = New String(New Char(31) {})
      126. dm.dmFormName = New String(New Char(31) {})
      127. dm.dmSize = CShort(Marshal.SizeOf(dm))
      128. 'Auflösung umstellen
      129. Dim ret As Integer = ChangeDisplaySettingsEx(deviceName, dm, 0&, CDS_UPDATEREGISTRY, 0&)
      130. Select Case ret
      131. Case DISP_CHANGE_FAILED
      132. MessageBox.Show("Die Auflösung konnte nicht verändert werden !!!")
      133. Return False
      134. Case DISP_CHANGE_SUCCESSFUL
      135. Return True
      136. Case DISP_CHANGE_RESTART
      137. MessageBox.Show("Zur Umstellung der Auflösung muss das System neu gebootet werden.")
      138. Return True
      139. Case Else
      140. Return False
      141. End Select
      142. dm = Nothing
      143. Return True
      144. End Function
      145. #End Region
      147. #Region "Properties"
      148. ''' <summary>Gibt eine Liste mit allen möglichen Bildschrimauflösungen zurück.</summary>
      149. ''' <returns>Bildschirmauflösungen List(Of ScreenResolution)</returns>
      150. Public ReadOnly Property ScreenResolutions() As List(Of ScreenResolution)
      151. Get
      152. Return ScreenRes
      153. End Get
      154. End Property
      155. #End Region
      156. End Class


      Gruss

      mikeb69

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „mikeb69“ () aus folgendem Grund: Code Formatierung bearbeitet

      thx.

      Ich hab jetzt eine kl. SampleSolution gebastelt, die euch natürlich auch nicht erspart bleibt ;).

      Dazu 2 kl Änderungen:
      1. die Daten als Property designed, sodaß Databinding unterstützt wird

        VB.NET-Quellcode

        1. 'struktur die die bildschirmauflösung beschreibt
        2. Public Structure ScreenResolution
        3. Public Property Resolution As Size
        4. Public Property ColorDeptI As Short
        5. Public Property ColorDeptS As String
        6. Public Property Total As String
        7. End Structure


      2. bei der ChangeResolution-Methode das ColorDept-Argument auf Short geändert, weil Option Strict On! meckert richtigerweise an, dass ein Integer kein Short ist:

        VB.NET-Quellcode

        1. Public Function ChangeRes(ByVal res As Size, ByVal colorDept As Short) As Boolean


      Jo, und dann ein kl. Form, was alle verfügbaren Auflösungen anzeigt, und man kann eine davon anwenden. (Zum Schließen wirds dann wieder rückgängig gemacht.)

      VB.NET-Quellcode

      1. Imports System.IO
      2. Imports ScreenResolutions.ClassDisplay
      3. Public Class frmScreenResolutions
      5. Dim displ As ClassDisplay
      6. Dim _Orig As ScreenResolution 'zur Wiederherstellung der Orig-Einstellung
      8. Private Sub frmScreenResolutions_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
      9. displ = New ClassDisplay(Screen.PrimaryScreen.DeviceName)
      10. Me.ClassDisplay_ScreenResolutionBindingSource.DataSource = displ.ScreenResolutions
      11. _Orig = displ.ScreenResolutions(0)
      12. End Sub
      14. Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click
      15. Dim curr = DirectCast(ClassDisplay_ScreenResolutionBindingSource.Current, ScreenResolution)
      16. displ.ChangeRes(curr.Resolution, curr.ColorDeptI)
      17. End Sub
      19. Private Sub frmScreenResolutions_FormClosed(ByVal sender As Object, ByVal e As FormClosedEventArgs) Handles Me.FormClosed
      20. displ.ChangeRes(_Orig.Resolution, _Orig.ColorDeptI)
      21. End Sub
      23. End Class
      Dateien

    Facebook
    Telefonspende