每分钟自动换桌面壁纸

Question

在类模块中加入
Private Const SPI_SETDESKWALLPAPER = 2


Private Const SPIF_SENDWININICHANGE = &H2


Private Const SPIF_UPDATEINIFILE = &H1


Private 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


Public Sub changedesk()
Dim i As Integer


Randomize
i = Int(25 * Rnd)'如果你有25张墙纸(数量看自己情况定），而且把墙纸的文件名改为0-25.bmp


ret& = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "filepath" +CStr(i) + ".bmp", SPIF_UPDATEINIFILE) 'filepath 为bmp所在文件夹
End Sub


在form1中加入timer1,并把form1.visible=false


Private Sub Form_Load()
Timer1.Interval = 60000 '设为一分钟
changedesk
End Sub


Private Sub Timer1_Timer()
changedesk
End Sub
这样你的桌面就会每分钟换一张墙纸了！