自动更换墙纸的小软件


---- 这个小软件所用控件仅一列表框，两文本框，两标签，两命令及一定时控件而已。其界面如下：



---- 源代码：

Declare Function SystemParametersIn
fo 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

---- （本程序开发环境：Win98，VB6.0）