一个自动更换墙纸的小软件

一个自动更换墙纸的小软件

烟台电信局多媒体信息分局 潘建明

　 这个小软件的功能，自然无法同久已成名的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