首页 > 代码库 > Bing缤纷壁纸
Bing缤纷壁纸
微软Bing必应搜索网站有一个很棒的特色,每天都会换一张精美的背景图片。
对懒人来说,如果自己电脑的桌面也能这样每天自动更换壁纸那该多好啊。
那么,Bing缤纷壁纸来了。
软件的界面很简单,自动下载的的壁纸来自必应中国,所以中国新年也会有一些特色的图片。
第一个版本使用Windows Design,看起来丑丑的。
第二个版本使用Material Design风格,别具特色。
不多说,上截图。
第一版:
第二版:
下载地址:Bing缤纷壁纸
点击 获取缤纷壁纸 ,将在C:\BingWallpaper\文件夹内生成壁纸,还可以拷贝到其他设备中。
继续开源:
'Copyright (c) 2014,烟台大学计算机学院 'All gight reserved. '文件名称:temp.cpp '作者:邵帅 '完成时间:2014年12月20日 '版本号:v3.0.2 Option Explicit Private 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 Long Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Private Const SPI_SETDESKWALLPAPER = 20 Private Const SPIF_UPDATEINIFILE = &H1 Dim Wallpaper As String Public 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 = True End Function Private Sub Image1_Click() End Sub Private 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 If End Sub Private 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 If End Sub Private Sub Image4_Click() If Dir("C:\BingWallpaper", vbDirectory) = "" Then '判断文件夹是否存在 MkDir ("C:\BingWallpaper") '创建文件夹 End If Shell "explorer.exe ""C:\BingWallpaper""", vbNormalFocus '打开相应的文件夹 End Sub Private Sub Image5_Click() Form2.Show End Sub Private Sub Image6_Click() End End Sub<strong> </strong>
Bing缤纷壁纸
@ Mayuko
Bing缤纷壁纸
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。