SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, "C:\Myphoto.jpg", #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE)
but it don't work!

i use winxp.
can you help me?

Thanks!
Ciao Gianluca.
Code: Select all
#WPSTYLE_CENTER = 0
#WPSTYLE_TILE = 1
#WPSTYLE_STRETCH = 2
#WPSTYLE_MAX = 3
#AD_APPLY_SAVE = 1
#AD_APPLY_HTMLGEN = 2
#AD_APPLY_REFRESH = 4
#AD_APPLY_FORCE = 8
#AD_APPLY_ALL = #AD_APPLY_SAVE | #AD_APPLY_HTMLGEN | #AD_APPLY_REFRESH
Structure myWALLPAPEROPT
dwSize.l
dwStyle.l
EndStructure
wallpaperOptions.myWALLPAPEROPT
wallpaperOptions\dwSize = SizeOf(myWALLPAPEROPT)
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@deskObj.IActiveDesktop) <> #S_OK
MessageRequester("Error", "Could not create object")
quit = #True
EndIf
Global wallpaperOptions, deskObj
Procedure doWallpaper(myWallpaper$)
; get option selection
If GetGadgetState(2)
wallpaperOptions\dwStyle = #WPSTYLE_TILE
ElseIf GetGadgetState(3)
wallpaperOptions\dwStyle = #WPSTYLE_STRETCH
Else
wallpaperOptions\dwStyle = #WPSTYLE_CENTER
EndIf
; allocate for wStr filename
filenameWide = AllocateMemory(Len(myWallpaper$)*2+2)
MultiByteToWideChar_(#CP_ACP, 0, @myWallpaper$, -1, filenameWide, Len(myWallpaper$)*2+2)
If deskObj\SetWallpaper(filenameWide, 0) = #S_OK
If deskObj\SetWallpaperOptions(@wallpaperOptions, 0) =#S_OK
If deskObj\ApplyChanges(#AD_APPLY_SAVE) <> #S_OK
MessageRequester("Error", "Unable to apply changes to Wallpaper.")
EndIf
EndIf
EndIf
FreeMemory(filenameWide)
ProcedureReturn 0
EndProcedure
If OpenWindow(0, 10, 10, 200, 150, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Change Wallpaper")
If CreateGadgetList(WindowID())
ButtonGadget(1, 50, 10, 100, 40, "Select Wallpaper")
OptionGadget(2, 60, 60, 100, 20, "Tile")
OptionGadget(3, 60, 90, 100, 20, "Stretch")
OptionGadget(4, 60, 120, 100, 20, "Center")
SetGadgetState(3,1)
EndIf
EndIf
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_EventGadget
Select EventGadgetID()
Case 1
wallpaper$ = Space(#MAX_PATH)
wallpaper$ = OpenFileRequester("Select Wallpaper", "c:\", "*.bmp *.jpg *.jpeg | *.bmp;*.jpg", 0 )
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 2
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 3
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 4
If wallpaper$
doWallpaper(wallpaper$)
EndIf
EndSelect
Case #PB_Event_CloseWindow
quit = #True
EndSelect
Until quit = #True
If deskObj
deskObj\release()
EndIf
CoUninitialize_()
End
DataSection
CLSID_ActiveDesktop:
Data.l $75048700
Data.w $EF1F,$11D0
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9
IID_IActiveDesktop:
Data.l $F490EB00
Data.w $1240,$11D1
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9
EndDataSection
Code: Select all
If deskObj\SetWallpaper(filenameWide, 0) = #S_OK
Code: Select all
; set registry keys for center/tile/stretch
If RegOpenKeyEx_(#HKEY_CURRENT_USER, "Control Panel\\Desktop\\", 0, #KEY_ALL_ACCESS, @key.l) = #ERROR_SUCCESS
Select WPType
Case "c" ; center
TileWP.s = "0"
WPStyle.s = "1"
Case "t" ; tile
TileWP.s = "1"
WPStyle.s = "0"
Case "s" ; stretch
TileWP.s = "0"
WPStyle.s = "2"
EndSelect
RegSetValueEx_(key, "TileWallpaper", 0, #REG_SZ, TileWP, 2)
RegSetValueEx_(key, "WallpaperStyle", 0, #REG_SZ, WPStyle, 2)
EndIf
Code: Select all
;...Wallpaper changer by Sparkie
#WPSTYLE_CENTER = 0
#WPSTYLE_TILE = 1
#WPSTYLE_STRETCH = 2
#WPSTYLE_MAX = 3
#AD_APPLY_SAVE = 1
#AD_APPLY_HTMLGEN = 2
#AD_APPLY_REFRESH = 4
#AD_APPLY_FORCE = 8
#AD_APPLY_BUFFERED_REFRESH = 10
#AD_APPLY_COMPLETEREFRESH = 20
#AD_APPLY_DYNAMICREFRESH = 20
#AD_APPLY_ALL = #AD_APPLY_SAVE | #AD_APPLY_HTMLGEN | #AD_APPLY_REFRESH
Structure myWALLPAPEROPT
dwSize.l
dwStyle.l
EndStructure
Global wallpaperOptions.myWALLPAPEROPT
Global deskObj.IActiveDesktop
CoInitialize_(0)
If CoCreateInstance_(?CLSID_ActiveDesktop,0,1,?IID_IActiveDesktop,@deskObj.IActiveDesktop) <> #S_OK
MessageRequester("Error", "Could not create object")
Quit = #True
EndIf
Procedure doWallpaper(myWallpaper$)
wallpaperOptions\dwSize = SizeOf(myWALLPAPEROPT)
;... get option selection
If GetGadgetState(2)
wallpaperOptions\dwStyle = #WPSTYLE_TILE
ElseIf GetGadgetState(3)
wallpaperOptions\dwStyle = #WPSTYLE_STRETCH
Else
wallpaperOptions\dwStyle = #WPSTYLE_CENTER
EndIf
;... allocate for wStr filename
*filenameWide = AllocateMemory(Len(myWallpaper$)*2+2)
PokeS(*filenameWide, myWallpaper$, -1, #PB_Unicode)
If deskObj\SetWallpaperOptions(@wallpaperOptions, 0) = #S_OK
If deskObj\SetWallpaper(*filenameWide, 0) = #S_OK
If deskObj\ApplyChanges(#AD_APPLY_ALL) <> #S_OK
MessageRequester("Error", "Unable to apply changes to Wallpaper.")
EndIf
EndIf
EndIf
FreeMemory(*filenameWide)
ProcedureReturn 0
EndProcedure
If OpenWindow(0, 10, 10, 200, 150, "Change Wallpaper", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
ButtonGadget(1, 50, 10, 100, 40, "Select Wallpaper")
OptionGadget(2, 60, 60, 100, 20, "Tile")
OptionGadget(3, 60, 90, 100, 20, "Stretch")
OptionGadget(4, 60, 120, 100, 20, "Center")
SetGadgetState(3,1)
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case 1
wallpaper$ = Space(#MAX_PATH)
wallpaper$ = OpenFileRequester("Select Wallpaper", "c:\", "*.bmp *.jpg *.jpeg | *.bmp;*.jpg", 0 )
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 2
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 3
If wallpaper$
doWallpaper(wallpaper$)
EndIf
Case 4
If wallpaper$
doWallpaper(wallpaper$)
EndIf
EndSelect
Case #PB_Event_CloseWindow
Quit = #True
EndSelect
Until Quit = #True
If deskObj
deskObj\Release()
EndIf
CoUninitialize_()
EndIf
End
DataSection
CLSID_ActiveDesktop:
Data.l $75048700
Data.w $EF1F,$11D0
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9
IID_IActiveDesktop:
Data.l $F490EB00
Data.w $1240,$11D1
Data.b $98,$88,$00,$60,$97,$DE,$AC,$F9
EndDataSection
no problem...Sparkie wrote:@Kaeru Gaman: Sorry I was late![]()
I completely understand your point of view on Active Desktop. I can't guarantee you the same success as me, but I do NOT have Active Desktop enabled on my XP system and my code above works just fine with no problems.Kaeru Gaman wrote:...and I will not try a Code that may change my Desktop to "Active".