众所周知在Windows中可以通过属性面板任意修改背景图案,要在VB的程序设计中实现这一功能其实也很方便,具体实现方法如下:  首先在VB中创建一个窗体并在其中加入一个命令按钮,第一步在窗体的通用段中输入以下代码:  Const SPI_SETDESKWALLPAPER = 20  Const SPIF_UPDATEINIFILE = &&H1  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  注:如果以上的声明放在“一般模块”下, 应在 Const 之前加上 Public 保留字, 并且将 Private 保留字去掉。  然后在命令按钮中的Click事件中输入以下代码:  '将桌面图片设定成 c:\windows\CIRCLES.bmp  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,"c:\windows\CIRCLES.bmp", SPIF_UPDATEINIFILE)  '将桌面图片清除  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,"",SPIF_UPDATEINIFILE)  但以上程序设定图片之后, 必须等到下次 Windows 重新启动时才生效, 如果要设定之后立刻生效,则程序须修改如下:  Const SPIF_SENDWININICHANGE = &&H2  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\CIRCLES.bmp", SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE )  此外如果只有本次使用 Windows 时改变桌面图片(下次开机时还原原状), 则程序如下:  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\windows\CIRCLES.bmp", SPIF_SENDWININICHANGE ) ' 去掉 SPIF_UPDATEINIFILE

解决方案 »

  1.   

    'Registry Constants
    Const REG_SZ = 1
    Const REG_BINARY = 3
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_USERS = &H80000003'Registry Declarations
    Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, 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
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long'Subroutine to save String Data to registry Key
    Sub SaveRegistryString(hKey As Long, keyPath As String, strName As String, strData As String)
        
        'Open the registry and save any new values
        Dim RetCode                             'Return Code Variant
        RegCreateKey hKey, keyPath, RetCode     'Creates Registry Key[hKey] if nonexistent or Opens Registry Key[hKey] if it exists
        RegSetValueEx RetCode, strName, 0, REG_SZ, ByVal strData, Len(strData)  'Writes data(strData) to a Registry Key[hKey] value[strName]
        RegCloseKey RetCode                     'Closes Registry Key[hKey]
        
    End Sub'Main program loop.  Forms visible attribute is set to false.
    Private Sub Form_Load()
        
        Dim fileName As String, filePath As String, ErrCode As Long     'Local variables
        
        'Search for all the image files that can be used or converted in a specific directory
        filePath = "c:\winnt\web\wallpaper"   'Sets the directory[filePath] where you store your images
        flbTemp.Path = filePath                 'Sets the FileListBox[flbTemp] with the store path[filePath]
        flbTemp.Pattern = "*.bmp;*.jpg;*.gif;*.dib;*.wmf;*.emf" 'Fills the FileListBox[flbTemp] with all the images in the store directory[filePath] of the types that can be used
        If flbTemp.ListCount = 0 Then Unload Me 'If no files of the appropriate type exist then exit program now
        
        'Randomly select an image form the generated list of images
        Randomize Timer                         'Generate random sequence based on the number of seconds since midnight[Timer]
        fileName = filePath + "\" + Trim(flbTemp.List(Int(Rnd * (flbTemp.ListCount))))  'Randomly selects an image[fileName] from the FileListBox[flbTemp]
        
        'Convert and save an image to the BMP format so we don't have to set Active Desktop (which slows down the screen redraws)
        picTemp.AutoRedraw = True   'Set the picturebox[picTemp] to automatically redraw the image[fileName] that is to be used to memory
        picTemp.AutoSize = True     'set the picturebox[picTemp] to automatically resize the image[fileName] that is to be used to memory
        Set picTemp.Picture = LoadPicture(fileName) 'Load the image[fileName] into memory via the picturebox[picTemp]
        picTemp.Refresh             'Refresh the picturebox[picTemp] so that the image[fileName] can be resized and redrawn in memory
        
        'save the converted image info to the registry and set it to cover our entire screen
        SavePicture picTemp.Image, App.Path + "\temp.bmp"   'Convert and save the image[filename] in memory to the harddisk as a bitmap[temp.bmp]
        SaveRegistryString HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaper", App.Path + "\temp.bmp"  'Set the location of our convert image[temp.bmp] into the appropriate Registry Key (Wallpaper property in the display settings)
        SaveRegistryString HKEY_CURRENT_USER, "Control Panel\Desktop", "WallpaperStyle", "2"                'set our converted image[temp.bmp] to cover our desktop regardless of resolution into the appropriate Registry Key (Wallpaper property in the display settings)
        SaveRegistryString HKEY_USERS, ".DEFAULT\Control Panel\Desktop", "Wallpaper", App.Path + "\temp.bmp"    'Repeat the above settings here just to make sure that it takes
        SaveRegistryString HKEY_USERS, ".DEFAULT\Control Panel\Desktop", "WallpaperStyle", "2"                  'Repeat the above settings here just to make sure that it takes
        
        'All Done
        Unload Me                   'Close the program
        
    End Sub