一个自动更换墙纸的小软件
只要你有一台电脑或者手机,都能关注图老师为大家精心推荐的一个自动更换墙纸的小软件,手机电脑控们准备好了吗?一起看过来吧!
这个小软件所用控件仅一列表框,两文本框,两标签,两命令及一定时控件而已。
源代码:
DeclareFunctionSystemParametersInfoLib"user32"Alias"SystemParametersInfoA"(ByValuActionAsLong,ByValuParamAsLong,ByVallpvParamAsAny,ByValfuWinIniAsLong)AsLong
DimflagAsBoolean
ConstSPI_SETDESKWALLPAPER=20
ConstSPIF_UPDATEINIFILE=&H1
'updateWin.iniConstant
ConstSPIF_SENDWININICHANGE=&H2
'updateWin.iniandtelleveryone
PrivateSubCmdCancel_Click()
flag=False
Textpath=""
Textintval=""
Listfile.Clear
EndSub
PrivateSubCmdOK_Click()
DimtempAsString
temp=Textpath.Text
Iftemp=""ThenEnd
IfRight$(temp,1)""Then
temp=temp ""
EndIf
Listfile.Tag=temp
temp=temp "*.bmp"
temp=Dir$(temp)
Whiletemp""
Listfile.AddItemtemp
temp=Dir$
Wend
Listfile.AddItem"None"
Show
Listfile.ListIndex=0
IfListfile.List(0)="None"Then
flag=False
Else
flag=True
EndIf
EndSub
PrivateSubForm_Load()
flag=False
Timer1.Interval=Val(Textintval.Text)
EndSub
PrivateSubTimer1_Timer()
DimtempAsString
DimbmpfileAsString
IfflagThen
temp=Listfile.Tag
bmpfile=temp Listfile.List(Listfile.ListIndex)
SystemParametersInfoSPI_SETDESKWALLPAPER,0,bmpfile,SPIF_UPDATEINIFILE
IfListfile.ListIndex=Listfile.ListCount-1Then
Listfile.ListIndex=0
EndIf
Listfile.ListIndex=Listfile.ListIndex 1
EndIf
EndSub->