这个小软件的功能,自然无法同久已成名的WPC(wallpaper changer)相媲美,但由于是自制的,用起来又别有一番乐趣。古人言,“独乐”不如“众乐”,所以我拿出来与大家共享,又希望能让初学者对于VB编程窥见一斑。

  这个小软件所用控件仅一列表框,两文本框,两标签,两命令及一定时控件而已。

  源代码:

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
Dim flag As Boolean
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1 
'update Win.ini Constant
Const SPIF_SENDWININICHANGE = &H2
'update Win.ini and tell everyone

Private Sub CmdCancel_Click()
  flag = False
  Textpath = ""
  Textintval = ""
  Listfile.Clear
End Sub

Private Sub CmdOK_Click()
  Dim temp As String
  temp = Textpath.Text
  If temp = "" Then End
  If Right$(temp, 1) <> "\" Then
    temp = temp + "\"
  End If
  Listfile.Tag = temp
  temp = temp + "*.bmp"
  temp = Dir$(temp)
  While temp <> ""
    Listfile.AddItem temp
    temp = Dir$
  Wend
  Listfile.AddItem "None"
  Show
  Listfile.ListIndex = 0
  If Listfile.List(0) = "None" Then
    flag = False
  Else
    flag = True
  End If
End Sub

Private Sub Form_Load()
  flag = False
  Timer1.Interval = Val(Textintval.Text)
End Sub

Private Sub Timer1_Timer()
  Dim temp As String
  Dim bmpfile As String
  If flag Then
    temp = Listfile.Tag
    bmpfile = temp + Listfile.List(Listfile.ListIndex)
    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, bmpfile, SPIF_UPDATEINIFILE
    If Listfile.ListIndex = Listfile.ListCount - 1 Then
      Listfile.ListIndex = 0
    End If
    Listfile.ListIndex = Listfile.ListIndex + 1
  End If
End Sub