Post Reply
Chandler 2009-06-10 19:39
I want to have my dual-screen wallpapers cycle randomly on a set interval. I'm currently using the ChangeWallpaperAuto2 script from the script page. It works great, but it just goes down the list from top to bottom. I'd like it to be random.
So basically I want a script exactly like that, but with a randomizer built in.
Is there anyway to do this?
Thanks! Chandler
A little nonsense now and then is relished by the wisest men. -Willy Wonka-
|
Chandler 2009-06-12 16:16
Well I got the code from somewhere else. Here it is in case someone else wants to use it.
Option Explicit
Const INTERVAL = 20 'interval between wallpaper changes in minutes
Const UMDESKTOP_EXE = "%ProgramFiles%\UltraMon\UltraMonDesktop.exe"
Dim sh, fso
Set sh = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
'check if UltraMon 3 or later is installed
Dim umVer
umVer = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\CurrentVersion")
'get the location of the wallpaper folder(s)
Dim dirWps
If umVer = "" Then
'UltraMon 2, location of the user and shared wallpaper folders stored in the registry
ReDim diwWps(1)
dirWps(0) = sh.RegRead("HKCU\Software\Realtime Soft\UltraMon\Wallpaper\Wallpaper Directory")
dirWps(1) = sh.RegRead("HKLM\Software\Realtime Soft\UltraMon\Wallpaper\All Users Wallpaper Directory")
Else
'UltraMon 3 or later, wallpaper folder is at a known location
ReDim dirWps(0)
dirWps(0) = sh.ExpandEnvironmentStrings("%APPDATA%\Realtime Soft\UltraMon\" & umVer & "\Wallpapers")
End If
Dim files : ReDim files(100) ' arbitrary size
Dim filecount : filecount = -1
'enumerate available wallpapers
Dim i, fldName, fldWp, fileWp, fileWpFullName
For i = 0 To UBound(dirWps)
fldName = dirWps(i)
If Right(fldName, 1) <> "\" Then fldName = fldName & "\"
Set fldWp = fso.GetFolder(fldName)
For Each fileWp In fldWp.Files
If Right(fileWp.Name, 10) = ".wallpaper" Then
fileWpFullName = fldName & fileWp.Name
' found a file...put it in the files array:
filecount = filecount + 1
' if we need to grow the array, do so arbitrarily:
If filecount > UBound(files) Then ReDim Preserve files(filecount+20)
files(filecount) = fileWpFullName
End If
Next
Next
' chop the array of files to the right length:
' (not necessary, really)
ReDim Preserve files(filecount)
' *NOW* start picking at random:
Randomize ' only do this once per app
Dim pick, lastPick, temp
lastPick = ""
Do While True ' forever
' randomize the array:
For i = 0 To filecount
pick = INT( RND() * (filecount+1) )
temp = files(pick)
files(pick) = files(i)
files(i) = temp
Next
' don't allow first pick of new ordering to be
' same as last pick of prior ordering (to be sure
' you won't get same file twice in a row)
If files(0) = lastPick Then
files(0) = files(filecount)
files(filecount) = lastPick
End If
' now run through the re-ordered array one time:
For pick = 0 To filecount
fileWpFullName = files(pick)
lastPick = fileWpFullName
'load next wallpaper
Dim cmd
cmd = """" & UMDESKTOP_EXE & """ /load " & fileWpFullName
sh.Run cmd
'wait
WScript.Sleep INTERVAL * 60 * 1000
Next
' and the loop will cause a reorder of array and
' then do it all again
Loop
A little nonsense now and then is relished by the wisest men. -Willy Wonka-
|
smiffer 2010-01-13 02:38
How exactly do I utilize this script? I went to the UltraMon help and there is a section on scripting but I don't see how I actually utilize them. So I would copy the above script, open notepad, paste the script in and save it as say RandomWallpaper.vbs? Then where do I save this?
|
Christian Studer 2010-01-13 09:56
That's pretty much it, you can save the file anywhere you want, then double-click it to launch the script.
Christian Studer - www.realtimesoft.com
|
Post Reply
|