Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Fürs vbarchiv-team...
Autor: Semy
Datum: 10.12.03 14:54
Hallo, ich habe mich mit dem Tipp Bildschirm-Einstellungen ermitteln und ändern etwas beschäftigt. Im ersten Beispiel gibt es einen Fehler ! Habe den Code etwas umgeschrieben. Es werden die Benutzereinstellungen vor dem ändern gespeichert und beim entladen der Anwendung wieder zurückgesezt. Habe mir gedacht vieleicht könnt Ihr das gebrauchen.... semy Option Explicit Dim oldX As Long Dim oldY As Long Dim oldColors As Long '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 Public Sub ChangeSettings(x As Long, y As Long, Bits As Long) Dim lResult As Long Dim DevM As DEVMODE lResult = EnumDisplaySettings(0&, 0&, DevM) With DevM .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL .dmPelsWidth = x .dmPelsHeight = y .dmBitsPerPel = Bits 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 Private Sub Form_Load() ' Ermitteln der aktuellen Einstellungen oldX = Screen.Width / Screen.TwipsPerPixelX oldY = Screen.Height / Screen.TwipsPerPixelY oldColors = GetDeviceCaps(hDC, BITSPIXEL) ' Mindestanforderung: ' 800x600 bei 16bit Farbtiefe (TrueColor) If oldX <> 800 Or oldY <> 600 Or oldColors < 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 800, 600, 16 Else ' Programm beenden End End If End If End Sub Private Sub Form_Unload(Cancel As Integer) 'Einstellungen zurücksetzen If oldX <> 800 Or oldY <> 600 Or oldColors < 16 Then ChangeSettings oldX, oldY, oldColors End If End Sub

Fürs vbarchiv-team...

439

Semy

10.12.03 14:54

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen