Hintergrund der Auflösung anpassen - www.itnator.net
2

Hintergrund der Auflösung anpassen

In manchen Situationen ist es erforderlich den Hintergrund des Desktops der Auflösung anzupassen. Wenn ein Bildschirm oder Anwendung eine bestimmte Auflösung benötigt, oder ein Monitor im Hochformat eingesetzt wird, verzerrt dies das Wallpaper. Um dies zu verhindern führen wir per Gruppenrichtlinie / GPO beim Start ein VB Script aus.

Pexels / Pixabay

 

Vorbereitungen

Um das Hintergrund-Bild der passenden Auflösung anpassen zu können, müssen wir folgende Vorbereitungen treffen:

 

Bilder bereitstellen

Um das zu realisieren, benötigen wir lokal auf dem Computer die Hintergrundbilder in den verschiedenen Auflösungen.
Ihr müsst also die Wallpaper erstellen (lassen) und an einen Ort kopieren, wo die Bilder niemanden stören.
In unserem Fall ist dies “C:\Windows\autobackground\” 🙂

(Eventuell auch per Gruppenrichtlinie)

 

Gruppenrichtlinie erstellen

Mit einer Gruppenrichtlinie auf dem Domain Controller haben wirs sehr einfach, weil es auf alle Computer des Active Directory angewendet werden kann.

Wir erstellen also eine Benutzer / User GPO, die beim Start ein Script ausführt:

 

Hintergrund der Auflösung anpassen

Nun zum eigentlichen Script. Ist zwar nicht schön geschrieben (Azubi – Zeit), aber es funktioniert 😉

  • In Zeile 20-81 werden eure Auflösungen definiert, die abgefragt werden sollen
  • In den Zeilen 92-102 werden die Pfade der Bilder hinterlegt
  • Ab Zeile 108 müsst ihr die Bilder den Auflösungen zuordnen
' SYNOPSIS:     Wallpaper der Aufloesung anpassen
' DESCRIPTION:  Aufloesung wird ausgelesen und anhand dessen das korrekte Wallpaper gesetzt
' VERSION:      1.0
' AUTHOR:       www.ITnator.net | Christian Gebhardt
' CREATED:      10.04.2018


Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objWMIService = GetObject("Winmgmts:\\.\root\cimv2") 
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0) 
strFileType = "JPG"

 
For Each objItem in colItems 
 intX = objItem.ScreenWidth 
 intY = objItem.ScreenHeight 
Next 


Select Case intX 
 Case "768" 
  Select Case intY 
   Case "1024" 
    strRes = intX & "x" & intY 
   Case "1280" 
    strRes = intX & "x" & intY 
  End Select 
 Case "900" 
  Select Case intY 
   Case "1600" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1024" 
  Select Case intY 
   Case "768" 
    strRes = intX & "x" & intY 
   Case "1280" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1050" 
  Select Case intY 
   Case "1680" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1080" 
  Select Case intY 
   Case "1920" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1152" 
  Select Case intY 
   Case "864" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1280" 
  Select Case intY 
   Case "768" 
    strRes = intX & "x" & intY 
   Case "920" 
    strRes = intX & "x" & intY 
   Case "1024" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1600" 
  Select Case intY 
   Case "900" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1680" 
  Select Case intY 
   Case "1050" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1920" 
  Select Case intY 
   Case "1080" 
    strRes = intX & "x" & intY 
   Case "1200" 
    strRes = intX & "x" & intY 
  End Select 
End Select 




dim shell
dim user
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
user = shell.ExpandEnvironmentStrings("%USERNAME%")
windowsDir = fso.GetSpecialFolder(0)
wallpaper1 = "C:\Windows\autobackground\4-3_1024x768.jpg"
wallpaper2 = "C:\Windows\autobackground\4-3_1280x1024.jpg"
wallpaper3 = "C:\Windows\autobackground\4-3_1600x1200.jpg"
wallpaper4 = "C:\Windows\autobackground\16-9_1024x600.jpg"
wallpaper5 = "C:\Windows\autobackground\16-9_1080x1920.jpg"
wallpaper6 = "C:\Windows\autobackground\16-9_1600x900.jpg"
wallpaper7 = "C:\Windows\autobackground\16-9_2560x1440.jpg"
wallpaper8 = "C:\Windows\autobackground\16-10_1440x900.jpg"
wallpaper9 = "C:\Windows\autobackground\16-10_1680x1050.jpg"
wallpaper10 = "C:\Windows\autobackground\16-10_1920x1200.jpg"
wallpaper11 = "C:\Windows\autobackground\16-10_1920x1200.jpg"





If intX=1024 And intY=768 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper1
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1280 And intY=1024 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper2
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1600 And intY=1200 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper3
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1024 And intY=600 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper4
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1080 And intY=1920 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper5
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1600 And intY=900 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper6
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=2560 And intY=1440 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper7
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1440 And intY=900 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper8
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1680 And intY=1050 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper9
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1920 And intY=1200 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper10
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1920 And intY=1080 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper11
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

Nach dem Ausführen des VB Scripts, solle euer Desktop – Hintergrund direkt geändert werden 🙂

Johannes Huber
 

In seiner Freizeit macht Johannes nichts lieber, als für ITnator Beiträge zu schreiben. Input bekommt er hierfür von Problemen in der IT Administration von Servern, Clients und vielen weiteren IT Komponenten.

  • Jemand Anders sagt:

    dim vid

    for each vid in getobject("winmgmts:").instancesof("Win32_VideoController")
    intX = vid.CurrentHorizontalResolution
    intY = vid.currentVerticalResolution
    next

    dim shell
    dim user

    Set shell = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    user = shell.ExpandEnvironmentStrings("%USERNAME%")
    windowsDir = fso.GetSpecialFolder(0)
    wallpaper = windowsDir & "autobackgroundshintergrund-"&intX&"x"&intY&".jpg"

    shell.RegWrite "HKCUControl PanelDesktopWallpaper", wallpaper
    shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True

    etwas kürzere version und funktioniert auf win10 😉

  • sidebar
    >