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

领测软件测试网

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

文章来源于领测软件测试网 https://www.ltesting.net/