Wie bekomme ich per VBS-Skript ALLE möglichen Auflösungen?
Guten Tag alle miteinander,
ich möchte alte PC-Spiele wieder aufleben lassen, Weil viele von denen jedoch ein sehr altes Seitenverhältnis (3:2 oder 4:3) nutzen und mein Monitor ein Ultra-Widescreen (21:9) ist, ist meine Auflösung meist die falsche. Das Bild wird dann entweder viel zu sehr gestreckt oder ist viel zu klein.
Nun soll mir ein automatisches Skript dabei helfen (es muss in VBS sein !), alle möglichen unterstützten Bildschirm-Auflösungen auszulesen und davon die niedrigste Auflösung mit dem passenden Seitenverhältnis auszuwählen (damit das Spiel möglichst den ganzen Bildschirm von innen ausfüllt) ohne gestreckt zu werden.
Das meiste bekomme ich schon selber hin, aber es gelingt mir noch nicht, ALLE von der jeweiligen Grafikkarte unterstützen Auflösungen aufzulisten (momentan bekomme ich nur die Aktuelle oder die Größtmögliche, das bringt mir aber nichts).
Mit welchem VBS-Code erreiche ich das?
Dragodraki
2 Antworten
videocontroller Auflösungen auflisten.
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
'frage alle Videomodi mit TrueColor und NoInterleased ab
Set colItems = objWMIService.ExecQuery("Select * from CIM_VideoControllerResolution where NumberOfColors=4294967296 and ScanMode=4",,48)
For Each objItem in colItems
Wscript.Echo "Horizontal Resolution: " & objItem.HorizontalResolution
Wscript.Echo "Number Of Colors: " & objItem.NumberOfColors
Wscript.Echo "Refresh Rate: " & objItem.RefreshRate
Wscript.Echo "Scan Mode: " & objItem.ScanMode
Wscript.Echo "Setting ID: " & objItem.SettingID
Wscript.Echo "Vertical Resolution: " & objItem.VerticalResolution
Wscript.Echo
Next
...natürlich werde ich keine Zeit und mühe in den alten Schrott investieren. Ich programmiere seit 35 Jahren und weine dem alten Kram keine Träne nach. Ich kann nicht verstehen, weshalb Du als Anfänger versuchst ein "totes Pferd" zu reiten. Selbst alte Hasen, wie ich, schätzen die Vorzüge moderner im System integrierter Sprachen wie C# oder Powershell, selbst wenn ich noch mit dem Scriptinghost kleine HilfsScripte für Batch ausführe, nutze ich JavaScript. Ich bin zwar kein Fan von Python, aber selbst Dieses ist besser als VBS.
Ich habe Dir bereits vor Monaten mitgeteilt, das VBScript ein Sprache auf dem sterbenden Ast ist. Kein Mensch erschafft neues mit VBS. Seit 10 Jahren schreibt jeder nur noch irgendwelche alten Scriptzeilen ab.
...Und natürlich ist es nicht möglich aus VBScript heraus den Bildschirmmodus zu ändern. (außer Fremdprogramme oder Registrypfrimelei)
Dein Problem lässt sich übrigens nicht durch Umschalten auf eine andere Auflösung ändern.
Im Setup Deiner Grafikkarte gib es eine Option, welche angibt, wie nichtbildfüllende Formate/Vollbildmodi zu handhaben sind.
...auch AMD hat eine adäquate Option.
Habs jetzt, der leere "Wscript.Echo" am Ende sollte weg und ich habs zusätzlich alle o.g. durch "msgbox" ersetzt - jetzt klappt es :). Tausend Dank!
Hi Leute,
@Erzesel: Danke für deinen Skriptentwurf. Konnte das Problem damit lösen.
ich habe die VBS jetzt ausgebaut und es funktioniert wie gewünscht. Für alle, die es interessiert, hier ist mein fertiges Skript (Hinweis: Für die Variablen "Mindestbreite", "Mindesthoehe" und "Seitenverhaeltnis" bitte eigene Werte eintragen!).
Codebefehle und -syntax sind ggf. umständlich, aber es funktioniert:
Option Explicit
On Error Resume Next
'RequireAdmin
dim objWMIService, colItems, objItem, LastResolutionShowed, AllResolutionList, AndereAufloesung, Mindestbreite, Mindesthoehe, Seitenverhaeltnis, Result, Aufloesungstest, Horizontale, Vertikale, AufloesungCheckpoint
' ---------------------------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------------------------
AndereAufloesung = "Ja" ' [Ja/Nein] Auflösung ändern ("Ja", wenn Spiel Auflösung/Seitenverhältnis nicht korrekt darstellt)
Mindestbreite = "800" ' optional: Niedrigste bildschirmfüllendste Auflösung (Breite), bevor Spiel Fehler bekommt (z.B. "720")
Mindesthoehe = "600" ' optional: Niedrigste bildschirmfüllendste Auflösung (Höhe), bevor Spiel Fehler bekommt (z.B. "480")
Seitenverhaeltnis = "4:3" ' optional: Erzwinge bestimmtes Seitenverhältnis, um Strecken/Stauchung zu vermeiden (z.B. "4:3" / "3:2")
' ---------------------------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------------------------
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
'frage alle Videomodi mit TrueColor und NoInterleased ab
Set colItems = objWMIService.ExecQuery("Select * from CIM_VideoControllerResolution where NumberOfColors=4294967296 and ScanMode=4",,48)
For Each objItem in colItems
if objItem.HorizontalResolution & " x " & objItem.VerticalResolution = LastResolutionShowed then
else
LastResolutionShowed = objItem.HorizontalResolution & " x " & objItem.VerticalResolution
'msgbox "Resolution: " & LastResolutionShowed
'msgbox "Number Of Colors: " & objItem.NumberOfColors
'msgbox "Refresh Rate: " & objItem.RefreshRate
'msgbox "Scan Mode: " & objItem.ScanMode
'msgbox "Setting ID: " & objItem.SettingID
AllResolutionList = AllResolutionList & vbCrLf & LastResolutionShowed
end if
Next
msgbox AllResolutionList
'--- BESTIMME AUFLÖSUNG, WENN -AndereAufloesung- JA IST
if AndereAufloesung = "Ja" OR AndereAufloesung = "ja" then
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
'frage alle Videomodi mit TrueColor und NoInterleased ab
Set colItems = objWMIService.ExecQuery("Select * from CIM_VideoControllerResolution where NumberOfColors=4294967296 and ScanMode=4",,48)
For Each objItem in colItems
Horizontale = objItem.HorizontalResolution
Vertikale = objItem.VerticalResolution
' Verhindere, dass gleiche Auflösungsmöglichkeiten mehrfach ausgegeben wird
if Horizontale & " " & Vertikale = LastResolutionShowed then
else
LastResolutionShowed = Horizontale & " " & Vertikale
' msgbox "------- " & LastResolutionShowed & " -------"
' Aufloesungstest_1: Ist ein bestimmtes Seitenverhältnis vorgegeben und wenn ja, passt die Auflösung dazu?
If IsNull(Seitenverhaeltnis) Or IsEmpty(Seitenverhaeltnis) Or Seitenverhaeltnis= "" Then
Aufloesungstest = Horizontale & " " & Vertikal
else
Seitenverhaeltnis=Replace(Seitenverhaeltnis,":","/")
' Konvertiere Zahlen aus dem String -Seitenverhaeltnis- zur mathematischen Division
result= nothing
result = left(Seitenverhaeltnis, instr(Seitenverhaeltnis, "/")-1) / right(Seitenverhaeltnis, len(Seitenverhaeltnis)-instr(Seitenverhaeltnis, "/"))
' Vergleiche Division -Seitenverhältnis- mit der aus der Division der Auflösung
if Horizontale / Vertikale = result Then
' msgbox "Super: Seitenverhältnis ist " & Seitenverhaeltnis
Aufloesungstest = Horizontale & " " & Vertikale
else
Aufloesungstest = ""
end if
end if
' Aufloesungstest_2: Ist eine bestimmte Mindesthöhe vorgegeben und wenn ja, ist die Vertikale der Auflösung mindestens genauso groß?
If IsNull(Mindesthoehe) Or IsEmpty(Mindesthoehe) Or Mindesthoehe = "" OR IsNull(Aufloesungstest) Or IsEmpty(Aufloesungstest) Or Aufloesungstest= "" Then
else
' Wandle String in Zahl um
Mindesthoehe = Mindesthoehe+0
' Verifiziere, dass vorgeschlagene Auflösung die Mindesthöhe nicht unterschreitet
if Mindesthoehe > Vertikale Then
'msgbox "Achtung: Mindesthöhe wurde unterschritten! Variable -Aufloesungstest- wird gelöscht"
Aufloesungstest = ""
else
Aufloesungstest = Horizontale & " " & Vertikale
end if
end if
' Aufloesungstest_3: Ist eine bestimmte Mindestbreite vorgegeben und wenn ja, ist die Horizontale der Auflösung mindestens genauso groß?
If IsNull(Mindestbreite) Or IsEmpty(Mindestbreite) Or Mindestbreite= "" OR IsNull(Aufloesungstest) Or IsEmpty(Aufloesungstest) Or Aufloesungstest= "" Then
else
' Wandle String in Zahl um
Mindestbreite = Mindestbreite+0
' Verifiziere, dass vorgeschlagene Auflösung die Mindestbreite nicht unterschreitet
if Mindestbreite > Horizontale Then
'msgbox "Achtung: Mindestbreite wurde unterschritten! Variable -Aufloesungstest- wird gelöscht"
Aufloesungstest = ""
else
Aufloesungstest = Horizontale & " " & Vertikale
end if
end if
' Ergebnis der Tests und Prüfen, ob diese Auflösung noch besser ist als vorige die Test bestanden haben
If IsNull(Aufloesungstest) Or IsEmpty(Aufloesungstest) Or Aufloesungstest= "" Then
' msgbox "Diese Auflösung hat mind. 1 der drei Anforderungen nicht erfüllt."
else
' Wenn neue Pixelsumme -Aufloesungstest- trotz Tests 1-3 niedriger ist als -AufloesungCheckpoint-, überschreibe -AufloesungCheckpoint-
if Vertikale * Horizontale < left(AufloesungCheckpoint, instr(AufloesungCheckpoint, " ")-1) * right(AufloesungCheckpoint, len(AufloesungCheckpoint)-instr(AufloesungCheckpoint, " ")) OR IsNull(AufloesungCheckpoint) Or IsEmpty(AufloesungCheckpoint) Or AufloesungCheckpoint= "" Then
AufloesungCheckpoint = Aufloesungstest
end if
end if
end if
Next
If IsNull(AufloesungCheckpoint) Or IsEmpty(AufloesungCheckpoint) Or AufloesungCheckpoint= "" Then
msgbox "Keine perfekte Auflösung möglich."
else
Resolution = AufloesungCheckpoint
msgbox "Nativste Auflösung aus den vorgegebenen Anforderungen ist: " & AufloesungCheckpoint
end if
else
end if ' egal, ob -AndereAufloesung- "Ja" oder "Nein" hat
Vielen Dank für deine Hilfe. Gründe, warum ich VBS nicht weg kann: Programmieren in richtiger Sprache kann ich nicht, habs versucht. Skriptsprache soll umstandslos auch auf Windows XP bis Windows 10 gleichermaßen laufen können. Und ich will kein Powershell, da das immer beliebter für Malwarexploits wird, habs daher in den Gruppenrichtlinien deaktiviert. Auch VBS habe ich sicherheitshalber so konfiguriert, dass es nur mit bestimmten Parametern läuft, sonst startet es nicht. CMD wäre gute Alternative, aber Fenstermodus nervt mich manchmal.
Vielleicht kannst du jetzt verstehen, warum es ausgerechnet VBS sein muss. Hast du einen anderen Vorschlag, der alle diese Bedingungen abdeckt, nehme ich ihn gerne an...
Zu dem Code von dir: Ich bekomme bis jetzt nur die niedrigste Option mit 640x480 raus, andere werden nicht aufgelistet. Bis jetzt gut, jetzt muss ich nur noch an die anderen herankommen.