Re: Bildschirmauflösung
From: Herbert Taferner (t.herbert_at_SPAMgmx.at)
Date: 03/08/05
- Next message: Herbert Taferner: "Re: Summe in Spalte nach Farbe?"
- Previous message: Steffen: "Arbeitsmappe läßt sicht nicht darstellen"
- In reply to: Heinrich Nickel: "Bildschirmauflösung"
- Next in thread: Michael Schwimmer: "Re: Bildschirmauflösung"
- Reply: Michael Schwimmer: "Re: Bildschirmauflösung"
- Messages sorted by: [ date ] [ thread ]
Date: Tue, 8 Mar 2005 06:47:16 +0100
Hallo Heinrich,
> Kann man die Bildschirmauflösung über VBA ändern?
>
> wenn ja, wie geht es dann.
>
ich habe mal dieses Makro gefunden
da werden alle unterstützten Modi ausgelesen
du brauchst nur eine Userform1 und darauf
eine ListBox mit Namen List1 und einen
CommandButton1 drauf die Anordnung
und größe der Objekte ist egal
das wird im Code erstellt
den folgenden Code in die Userform kopieren
'-----------------------------------------------
'Und nun zum eingangs erwähnten Beispiel, bei welchem alle
'vom System unterstützten Bildschirm-Einstellungen in einer
'Liste angezeigt werden sollen.
'Per Klick auf den Button ändern wird der gewählte Listen-Eintrag
'dann entsprechend neu gesetzt.
'Um das nachfolgende Beispiel ausprobieren zu können, starten Sie
'ein neues Projekt, plazieren auf die Form eine ListBox List1 und
'einen CommandButton1 fügen im Allgemein-Teil der Form1 den Code ein
Option Explicit
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 Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved 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
Const EWX_REBOOT = 2
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
' Alle unterstützen Bildschirm-Modi ermitteln
Public Sub GetAllScreenModes()
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
List1.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
List1.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 UserForm_Activate()
Userform1.Caption = "Bildschirmauflösung"
Me.Height = 160
Me.Width = 205
Me.List1.Top = 10
Me.List1.Left = 10
Me.List1.Height = 90
Me.List1.Width = 180
Me.CommandButton1.Top = 110
Me.CommandButton1.Left = 60
Me.CommandButton1.Width = 80
Me.CommandButton1.Height = 20
Me.CommandButton1.Caption = "ändern"
GetAllScreenModes
End Sub
' Einstellungen ändern
Private Sub CommandButton1_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
If MsgBox(" Auflösung neu" & _
Mid(List1.Value, InStr(1, List1.Value, "- ") + 1), vbOKCancel, _
"Bildschirmauflösung ändern") = vbOK Then
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
Call ExitWindowsEx(EWX_REBOOT, 0&)
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 If
Unload Me
Set Userform1 = Nothing
End Sub
'---------------------------------------
mfg Herbert
- Next message: Herbert Taferner: "Re: Summe in Spalte nach Farbe?"
- Previous message: Steffen: "Arbeitsmappe läßt sicht nicht darstellen"
- In reply to: Heinrich Nickel: "Bildschirmauflösung"
- Next in thread: Michael Schwimmer: "Re: Bildschirmauflösung"
- Reply: Michael Schwimmer: "Re: Bildschirmauflösung"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
