System.setwallpaper: Why is it copying my pictures?

Thursday, July 6, 2006 by sViz | Discussion: DesktopX

So I'm using drag and drop to get the file path to my pictures. I store the file path in object.persiststorage. Then, system.setwallpaper calls on object.persiststorage and
changes the wallpaper to whatever is in object.persistorage. (I hope you're still with me here). Now, when I go to My Pictures there is a copy of every picture that has been set as my wallpaper. Is this normal or am I doing something wrong? How do I correct this?

Any help or suggestions are greatly appreciated. Thank you.
12 Reply 6 Referrals
Garibaldi99
Reply #1 Thursday, July 6, 2006 6:14 PM
Interesting- I have a script running at work which changes the wallpaper automatically evry 10mins from a library of jpgs and it seems to copy them to bmps. I'm also running Active Desktop Calendar and thought it might have been something to do with that as it's a bit fussy about what it has as backgrounds so I haven't bothered investigating.....mmmm....I'll investigate further at work tomorrow...if I come up with anything I'll let you know....

sViz
Reply #2 Thursday, July 6, 2006 10:44 PM
Thanks. That's exactly what mine is doing--- making bmp copies.

Garibaldi99
Reply #3 Friday, July 7, 2006 5:33 AM
Ok, I don't know why it does it but it certainly does.
I'm no expert but this is the result of a couple of tests.
Can't do much more as I really should be working !!!

This simple script (in a DesktopX Object) results in copies of the jpgs into bmps in the original directory.

Dim fso, f, f1, fc, FName

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\Wallpapers")
Set fc = f.Files

ThisWall =Int((fc.Count-1)*Rnd() + 1)
cnt = 0

For Each f1 In fc
cnt = cnt + 1
If cnt = ThisWall Then
FName = f1.name
Exit For
End If
Next

FName = "C:\Wallpapers\"+FName

system.setwallpaper FName,1

It would appear that windows insists that the wallpaper is a bitmap - the following VB code works
if the file used is a bmp, but yields only a blank wallpaper if it's a jpg.

Private Declare Function SystemParametersInfo Lib "user32" _
Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
ByVal lpvParam As String, _
ByVal fuWinIni As Long) As Long

Sub Main()
SystemParametersInfo 20, 0, "C:\wallpapers\abc.bmp", 1
End Sub

I can only presume that something in VBScript or DesktopX itself does the copy before applying the
wallpaper.

Hope this is of some use.

sViz
Reply #4 Saturday, July 8, 2006 4:36 PM
I hate to bother you at your workplace but I'm not sure what all of that means. (Scripting amateur here) Where do I insert the script? Which parts would I have to modify? Most of the pictures I'm using are jpegs, so does that mean I can't use the script?


I should probably also mention that the wallpaper changes according to what day of the week it is. So, I have the script check that 1st and then change the wallpaper.

Garibaldi99
Reply #5 Sunday, July 9, 2006 6:49 AM
Sorry, basically what I'm saying is that Windows demands that the wallpaper is a bmp and that System.Setwallpaper would appear to do the copy from jpg to bmp so that it can apply it.
Therefore you just have to live with the fact that all your jpgs will get copied to bmps.
If you were using straight VB, you would need to do this yourself somehow but I'm guessing you're not as you say you're using System.Setwallpaper which is not a command in VB.
I may be able to help more if you can give me some specifics on what you're using (is it a desktopX object you've got from somewhere or something you've written yourself?)

sViz
Reply #6 Monday, July 10, 2006 4:17 PM
This is a DX object that I've written myself. If this problem can't be rectified then I can live with it. But, I would like to release this widget sometime and I'm sure other users would find the problem annoying.




Here is the script that I'm talking about. (Without all the bells and whistles)
*I hope this posts correctly


Sub Object_OnScriptEnter
d= weekday(date)
Select Case d
Case 1
System.SetWallpaper (object.PersistStorage("picpath")), 3

End Select
End Sub

Sub Object_OnDropFiles(files)
Dim path

path= Split(files, "|")
newpath= LBound(path)
newpath2= path(newpath)
object.PersistStorage("picpath") = newpath2
object.ToolTipText= (object.PersistStorage("picpath"))




d= weekday(date)
Select Case d
Case 1
System.SetWallpaper (object.PersistStorage("picpath")), 3
End Select
End Sub

Garibaldi99
Reply #7 Tuesday, July 11, 2006 1:17 PM
OK, I think probably the best way to deal with this is to copy the file you want to set as wallpaper to the windows directory before you set it, overwriting it each time.
Then you'll only ever have 2 copies (the jpg and the bmp).
Something like this:

Dim fso, sourcefile
Set fso = CreateObject ("Scripting.FileSystemObject")
Set windowspath = fso.GetSpecialFolder(0)
Set sourcefile = fso.GetFile("picpath")
sourcefile.Copy windowspath & "\wallpaperfile.jpg",True
system.setwallpaper windowspath & "\wallpaperfile.jpg",1

You'll then always have a wallpaperfile.jpg and a wallpaperfile.bmp but I guess most people could live with that (assuming they even notice it!)
Hope this is sufficient for you, it's the easiest way I can think of.

sViz
Reply #8 Tuesday, July 18, 2006 2:57 AM
I finally got around to trying the code you posted.

I kept getting a 'file not found' error until I changed this line:
Set sourcefile = fso.GetFile("picpath")


to this:
Set sourcefile = fso.GetFile (Object.PersistStorage("picpath"))


That stopped the errors. Now, when I tested it by dragging and dropping a picture onto the object the wallpaper did not change.
I'm not sure what to do now.( I wish I knew more about scripting  )

Garibaldi99
Reply #9 Tuesday, July 18, 2006 8:01 AM
OK, I've had another look and have gone for the belt and braces approach.

Try this:

Sub Object_OnScriptEnter
d= weekday(date)
Select Case d
Case 1
Call LSetWallpaper(Object.PersistStorage("picpath"))

End Select
End Sub

Sub Object_OnDropFiles(files)
Dim path

path= Split(files, "|")
newpath= LBound(path)
newpath2= path(newpath)
object.PersistStorage("picpath") = newpath2
object.ToolTipText= (object.PersistStorage("picpath"))




d= weekday(date)
Select Case d
Case 1
Call LSetWallpaper(Object.PersistStorage("picpath"))
End Select
End Sub

Sub LSetWallpaper(jpgFName)
Set fso = CreateObject ("Scripting.FileSystemObject")
Set windowspath = fso.GetSpecialFolder(0)
winbmp = windowspath & "\wallpaperfile.bmp"
winjpg = windowspath & "\wallpaperfile.jpg"
If fso.FileExists(winbmp) Then
fso.DeleteFile winbmp
End If
If fso.FileExists(winjpg) Then
fso.DeleteFile winjpg
End If
fso.CopyFile jpgFName,winjpg,True
System.SetWallpaper winjpg,3
End Sub

N.B. This assumes that all your source files are .jpg
Good luck.


sViz
Reply #10 Tuesday, July 18, 2006 2:09 PM
IT WORKED!!     Thank you very much, Garibaldi99! You've been very patient and extremely helpful.


To deal with the problem of having to use only jpegs I added a function to check the file extension. If it is a jpeg then I go through the code you gave me. If it isn't a jpeg (i.e. if it's a bitmap) then I set the wallpaper normally.

Here's the code:

Sub Object_OnScriptEnter
Call checkday
End Sub


Function checkday
d= weekday(date)
Select Case d
Case 3
Call checkext
End Select
End Function


Function checkext
Select Case (object.PersistStorage("ext"))
Case "jpg"
Call LSetWallpaper(Object.PersistStorage("picpath"))
Case Else
system.SetWallpaper (object.PersistStorage("picpath")), 3
End Select
End Function


Sub Object_OnDropFiles(files)
Dim path

path= Split(files, "|")
newpath= LBound(path)
newpath2= path(newpath)
object.PersistStorage("picpath") = newpath2
object.ToolTipText= (object.PersistStorage("picpath"))

dropfile= Split(path(newpath), ".")
ext= UBound(dropfile)
object.persiststorage("ext") = dropfile(ext)

Call checkday

End Sub



Sub LSetWallpaper(jpgFName)
Set fso = CreateObject ("Scripting.FileSystemObject")
Set windowspath = fso.GetSpecialFolder(0)
winbmp = windowspath & "\wallpaperfile.bmp"
winjpg = windowspath & "\wallpaperfile.jpg"
If fso.FileExists(winbmp) Then
fso.DeleteFile winbmp
End If
If fso.FileExists(winjpg) Then
fso.DeleteFile winjpg
End If
fso.CopyFile jpgFName,winjpg,True
System.SetWallpaper winjpg,3
End Sub



Now, everything works! I can't thank you enough, Garibaldi, for everything. Hopefully, I'll upload my widget soon.  

Garibaldi99
Reply #11 Tuesday, July 18, 2006 5:22 PM
Great! Glad I could be of assistance.
Look forward to seeing the fruits of your labours.

sViz
Reply #12 Saturday, July 29, 2006 11:26 PM
Hey, Garibaldi! I've uploaded my widget here...[it's awaiting Moderation]-Admin


It hasn't been approved yet so, what do you think of the look?

Please login to comment and/or vote for this skin.

Welcome Guest! Please take the time to register with us.
There are many great features available to you once you register, including:

  • Richer content, access to many features that are disabled for guests like commenting on the forums and downloading skins.
  • Access to a great community, with a massive database of many, many areas of interest.
  • Access to contests & subscription offers like exclusive emails.
  • It's simple, and FREE!
Login

Home | About | Privacy | Upload Guidelines | Terms of Service | Help
Copyright © Stardock Corporation. All Rights Reserved.


web-wc01