谁知道设置活动桌面的代码？

Option Explicit'This is the one that does the trick!!
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 SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1    'update Win.ini Constant
Const SPIF_SENDWININICHANGE = &H2 'update Win.ini and tell everyone
Private Sub Form_Load()
  Dim Temp As String
  
  Temp = InputBox("Please Input A Directory", "Changer", "C:\WINDOWS\")
  If Temp = "" Then End 'Cancel clicked
  
  If Right$(Temp, 1) <> "\" Then Temp = Temp + "\"
  
  'Place the entered path into the List1.Tag property for later
  'reference.  (Saves having a Global Variable)
  List1.Tag = Temp
  
  Temp = Temp + "*.bmp" 'Set the file filter (path + *.BMP)
  'Add all the BMP files we can find to the list
  Temp = Dir$(Temp)
  Do While Temp$ <> ""
    Temp = Dir$
    'if no file was found then exit the loop
    If Temp = "" Then Exit Do
      List1.AddItem Temp
  Loop
  
  'Give the optiopn do have no bitmap.
  List1.AddItem "(None)"
  
  Show
  List1.SetFocus
  List1.ListIndex = 0
End Sub
Private Sub list1_dblclick()
  Dim Temp As String
  Dim BMPFile As String
  
  Temp = Tag 'Retrieve the path again
  
  If List1.Text = "(None)" Then
    BMPFile = "(none)"
  Else
    BMPFile = Temp + (List1)
  End If
  
  SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal BMPFile, SPIF_UPDATEINIFILE
End SubPrivate Sub List1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then list1_dblclick
End Sub