微软Bing必应搜索网站有一个很棒的特色，每天都会换一张精美的背景图片。
对懒人来说，如果自己电脑的桌面也能这样每天自动更换壁纸那该多好啊。
那么，Bing缤纷壁纸来了。
软件的界面很简单，自动下载的的壁纸来自必应中国，所以中国新年也会有一些特色的图片。
第一个版本使用Windows Design，看起来丑丑的。
第二个版本使用Material Design风格，别具特色。
不多说，上截图。
第一版：
第二版：
下载地址：
点击 获取缤纷壁纸 ，将在C:\BingWallpaper\文件夹内生成壁纸，还可以拷贝到其他设备中。
继续开源：
'Copyright (c) 2014,烟台大学计算机学院 'All gight reserved. '文件名称：temp.cpp '作者：邵帅 '完成时间：2014年12月20日 '版本号：v3.0.2Option ExplicitPrivate Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongPrivate Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As LongPrivate Const SPI_SETDESKWALLPAPER = 20Private Const SPIF_UPDATEINIFILE = &H1Dim Wallpaper As StringPublic Function DownloadFile(URL As String, LocalFilename As String) As Boolean Dim lngRetVal As Long lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0) If lngRetVal = 0 Then DownloadFile = TrueEnd FunctionPrivate Sub Image1_Click()End SubPrivate Sub Image2_Click()Dim year, month, day Dim name As String Dim q As Boolean year = Format(Date, "yyyy") month = Format(Date, "mm") day = Format(Date, "dd") name = "C:\BingWallpaper\BingWallpaper" + year + "-" + month + "-" + day + ".jpg" If Dir("C:\BingWallpaper", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("C:\BingWallpaper") '创建文件夹 End If 'MsgBox name q = DownloadFile("http://cn.bing.com/hpwp/255ee0820925b9bdc7f23205cdc1d422", name) If q Then MsgBox "获取壁纸成功！", , "状态" End IfEnd SubPrivate Sub Image3_Click() Dim t As Long Dim year, month, day Dim name As String year = Format(Date, "yyyy") month = Format(Date, "mm") day = Format(Date, "dd") name = "C:\BingWallpaper\BingWallpaper" + year + "-" + month + "-" + day + ".jpg" Wallpaper = name If Wallpaper = "" Then Exit Sub t = SystemParametersInfo(ByVal SPI_SETDESKWALLPAPER, True, ByVal Wallpaper, SPIF_UPDATEINIFILE) MsgBox "更改壁纸成功！", , "状态" If t = 0 Then MousePointer = 0 MsgBox "更改壁纸出错。(错误代码：0x80c05)", , "状态" Exit Sub End IfEnd SubPrivate Sub Image4_Click()If Dir("C:\BingWallpaper", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("C:\BingWallpaper") '创建文件夹 End IfShell "explorer.exe ""C:\BingWallpaper""", vbNormalFocus '打开相应的文件夹End SubPrivate Sub Image5_Click()Form2.ShowEnd SubPrivate Sub Image6_Click()EndEnd Sub Bing缤纷壁纸
@ Mayuko