龙盟编程博客 | 无障碍搜索 | 云盘搜索神器
快速搜索
主页 > 软件开发 > VB开发 >

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

时间:2009-12-30 15:42来源:未知 作者:admin 点击:
分享到:
这个小软件的功能,自然无法同久已成名的WPC(wallpaperchanger)相媲美,但由于是自制的,用起来又别有一番乐趣。古人言,“独乐”不如“众乐”,所以我拿出来与大家共享,又希望能
这个小软件的功能,自然无法同久已成名的WPC(wallpaperchanger)相媲美,但由于是自制的,用起来又别有一番乐趣。古人言,“独乐”不如“众乐”,所以我拿出来与大家共享,又希望能让初学者对于VB编程窥见一斑。
  
   这个小软件所用控件仅一列表框,两文本框,两标签,两命令及一定时控件而已。
  
   源代码:
  
  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->

精彩图集

赞助商链接