Welche Bildschirmauflösungen bei welcher Farbtiefe und welchen Frequenzen werden von Windows für Ihren Monitor (Ihre Grafikkarte) unterstützt? 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 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 52.185 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
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. |