[RESOLVED] Wallpaper and screen saver

[schoolbusdriver]

Assuming you're using XP.

I've used all the following code in the past but haven't got a chance to test it before posting, but it should work.

To use a jpg as the wallpaper you have to use the active desktop. This routine should cope with both:

Public Sub Wallpaper_Set(WallPaper As String)
'Setting (WallPaper As String) to "" removes it.
   Dim X As Long
 
'Note how the string passed to the function is preceeded by the ByVal keyword.
'BMPs.
   X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ByVal WallPaper, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
'JPGs.
'If it's the active desktop the above fails, so...
   If X = 0 Then
'Use the code in this thread.
[url]http://www.vbforums.com/showthread.php?t=367342[/url] '<--------      
      ActiveDesktopSetWallpaper
   End If
End Sub

As for the screensaver, you have to write to the registry.

Option Explicit
 
'Form level code.
 
Private Sub Form_Click()
'Note. You MAY have to use GetShortPathName when retrieving the screensaver file name.
   modWriteRegSZ HKEY_LOCAL_MACHINE, "Control Panel\Desktop", "SCRNSAVE.EXE", "C:\WINDOWS\system32\MySaver.scr"
   ScreenSaver_Toggle True
End Sub

Option Explicit
 
'Module level code.
 
'Toggle the Screensaver on-off
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
   (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, _
   ByVal fuWinIni As Long) As Long
Private Const SPI_SETSCREENSAVEACTIVE = 17
 
'Registry APIs.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
   ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
   lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
 
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
   (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
   ByVal samDesired As Long, phkResult As Long) As Long
 
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
   (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
   ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
 
'Registry manipulation
Public Const HKEY_CURRENT_USER = &H80000001
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_SET_VALUE = &H2
 
Private Const REG_SZ = 1
Private Const ERROR_SUCCESS = 0&
 
Public Sub modWriteRegSZ(lngHKey As Long, strSubKey As String, strValueName As String, _
   strValue As String)
'Create the key and respective REG_SZ value.
   Dim lngRetVal     As Long
   Dim lngKeyHandle  As Long
 
'Create the key.
   If RegCreateKeyEx(lngHKey, strSubKey, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY, _
      ByVal 0&, lngKeyHandle, lngRetVal) <> ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Open the new key.
   If RegOpenKeyEx(lngHKey, strSubKey, 0&, KEY_SET_VALUE, lngKeyHandle) <> _
      ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Create a key and set its value.
   If RegSetValueEx(lngKeyHandle, strValueName, 0&, REG_SZ, ByVal strValue, Len(strValue) + 1) _
      <> ERROR_SUCCESS Then GoTo WRITE_SZ_ERROR
'Close the key.
   Call RegCloseKey(lngKeyHandle)
'Exit.
   Exit Sub
WRITE_SZ_ERROR:
'Close the key.
   Call RegCloseKey(lngKeyHandle)
'Time for any error handling.
   MsgBox "Error in modWriteRegSZ"
End Sub
 
Public Sub ScreenSaver_Toggle(Active As Boolean)
'To Activate Screen Saver, set active to true.
'To deactivate, set active to false.
   Dim lActiveFlag As Long
 
   lActiveFlag = IIf(Active, 1, 0)
   Call SystemParametersInfo SPI_SETSCREENSAVEACTIVE, lActiveFlag, 0, 0
End Sub