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

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

上一篇： 用VB自制屏幕保护程序
下一篇： VB编程步步高－代码效率篇

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有