title image


Smiley Re: Automatisches anpassen einer Form an die Bildschirmauflösung








Bildschirm-Einstellungen ermitteln und ändern

VB-Versionen: VB4, VB5, VB6

Betriebssystem: Win9x, WinNT, Win2000, WinME

Autor: Dieter Otter Homepage: http://www.tools4vb.de/

Datum: 07.06.2001 Download: -

Sprache: deutsch Views: 7323





Beschreibung



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 eingangs 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 unserer Homepage.





Ihre Bewertung:

1 2 3 4 5



37 Wertungen, Schnitt gut (4.3)

Diesen Tipp empfehlen | Neuen Tipp melden

Copyright 2000-2003 vb@rchiv � Alle Rechte vorbehalten - Der Download von Tipps oder Programmen von www.vbarchiv.net erfolgt auf eigene Gefahr. Das vbArchiv, die Redaktion sowie alle Mitarbeiter und Angestellten haften nicht für Schäden, die aus der Installation oder der Nutzung von Tipps oder Software aus dem Download-Bereich erfolgen. Trotz aktueller Virenprüfung ist eine Haftung für Schäden und Beeinträchtigungen durch Computerviren ausgeschlossen. Schadenersatzansprüche, aus welchem Rechtsgrund auch immer, sind ausgeschlossen, wenn das vbArchiv nicht Vorsatz oder grobe Fahrlässigkeit zu vertreten hat. Dies gilt auch für Ansprüche auf Ersatz von Folgeschäden wie Datenverlust.



vb@rchiv © 2000-2003 Dieter Otter



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.



Suchen | Weiterempfehlen | Gästebuch | Onlineshop | Impressum


Zur Lösung von Problemen siehe auch mini-down (u.a. einige nützliche links)

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: