Wallpaper Change VB6 code

Module:

'Retrieves or sets the value of one of the system-wide parameters
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

'Opens the specified registry key
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

'Sets the data and type of a specified value under a registry key
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, ByVal lpData As String, ByVal cbData As Long) As Long

'Writes all the attributes of the specified open registry key into the registry
Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'The RegCloseKey function releases the handle of the specified key
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'Creates the specified registry key
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001 'The HKEY_CURRENT_USER subtree contains the user profile for the user who is currently logged on to the computer

Private Const SPIF_SENDWININICHANGE = &H2 'Send Change Message
Private Const SPIF_UPDATEINIFILE = &H1 'Update INI File


Private Const SPI_SETDESKWALLPAPER = 20 'Change Wallpaper

Code:

Private Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, NewValue As String)

    Dim lResult As Long 'Result Of Write Operation
    
    Dim lKeyValue As Long 'Current Vlaue
    Dim lnLen As Long
    
    On Error Resume Next
    
    lResult = RegOpenKey(Group, Section, lKeyValue) 'Open The Key
    
    lnLen = Len(NewVal)
    
    'Write The Info
    lResult = RegSetValueEx(lKeyValue, Key, 0&, 1&, NewValue, lnLen)
    lResult = RegFlushKey(lKeyValue)
    
    'Close Key
    lResult = RegCloseKey(lKeyValue)

End Sub

' Routine to change the windows wallpaper
' NewWall = Name and path of required file
' WallStyle = Display type flag (  "Center", "Stretch" or "Tile" )
Private Sub ChangeWall(NewWall As String, WallStyle As String)

    Dim lReturn As Long 'Return of SysParInfo API
    
    'Determine WallPaper Style
    If WallStyle <> "Center" And WallStyle <> "Tile" And WallStyle <> "Stretch" Then
        WallStyle = "Stretch"
    End If
    
    'Determine Center
    If WallStyle = "Center" Then
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "0"
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "0"
        
    'Determine Tile
    ElseIf WallStyle = "Tile" Then
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "1"
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "0"
        
    'Determine Stretch
    ElseIf WallStyle = "Stretch" Then
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", "0"
        WriteRegistry HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "2"
    End If
    
    'Set the WallPaper
    lReturn = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, NewWall, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)

End Sub

Private Sub Command1_Click()

    Dim FileName As String 'File Loc Of Picture
    Dim WallStyle As String 'Style Of WallPaper

    FileName = "C:\WINDOWS\Gone Fishing.bmp"
    WallStyle = "Tile"
    
    Call ChangeWall(FileName, WallStyle)
    
End Sub