Hello all, I was wondering if someone could tell me an easy way to make this happen with the current slideshow code I am using. Here is what I would like to do, while the slideshow is running if I see a picture in the slideshow I would like to be able to left click on that image and have it set as my wallpaper. Here is the current code I'm using for the slideshow....
Thanks in advance
Dim files
Dim picscount
Dim grpofpics
Dim numofpics
Dim validpics
Dim foldercheck
Dim fs
Dim f
Dim f1
Dim fc
'Called when the script is executed
Sub Object_OnScriptEnter
picscount = 0
End Sub
Sub Object_OnDropFiles(files)
object.KillTimer 1
grpofpics = ""
'Files have extensions (.bmp), a folder does not
'We search the string to see if it contains a period
foldercheck = Instr(1, files, ".")
'If user drops a folder, get files within folder
If foldercheck = 0 Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(files)
Set fc = f.Files
For Each f1 In fc
'Check file extensions for valid images
checkext = Split(f1.name,".")
extension = LCase(checkext(1))
'Create a variable, listing only valid image files in folder
If extension = "bmp" Or extension = "png" _
Or extension = "ico" Or extension = "jpg" _
Or extension = "tga" Then
grpofpics = grpofpics & f & "\" & f1.name & "|"
End If
Next
'If there are images found, create array and count images
If grpofpics <> "" Then
grpofpics = Left(grpofpics, Len(grpofpics)-1)
grpofpics = Split(grpofpics, "|")
numofpics = UBound(grpofpics)
End If
'If user drops files
ElseIf foldercheck > 0 Then
grpofpics= Split(files, "|")
For Each elem In grpofpics
'Check file extensions for valid images
checkext = Instr(f1.name, ".")
If checkext > 0 Then
checkext = Split(f1.name,".")
extension = LCase(checkext(1))
End If
'Create a variable, listing only valid image files in folder
If extension = "bmp" Or extension = "png" _
Or extension = "ico" Or extension = "jpg" _
Or extension = "tga" Then
validpics= validpics & elem & "|"
End If
Next
'If there are images found, create array and count images
If validpics <> "" Then
validpics = Left(validpics, Len(validpics)-1)
grpofpics = Split(validpics, "|")
numofpics = UBound(grpofpics)
Else
grpofpics = ""
End If
End If
'If grpofpics contains images, set first picture on drop and add to picscount
If IsArray(grpofpics) = True Then
Object.Picture = grpofpics(0)
picscount = 1
Else
msgbox "No images found"
End If
'If there is more than one image start timer on drop
If numofpics > 0 Then object.SetTimer 1, 8000
End Sub
Sub Object_Ontimer1
'If count is higher than number of pics then reset count
If picscount > numofpics Then picscount = 0
'Set picture
Object.Picture = grpofpics(picscount)
'Add to count
picscount = picscount + 1
End Sub
Sub Object_OnStateChange(state)
If state="Command executed" Then
System.SetWallpaper Object.Directory & "vista-1.bmp", 3
End If
End Sub