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