61(1).txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

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

烟台电信局多媒体信息分局 潘建明
　  这个小软件的功能，自然无法同久已成名的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