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缤纷壁纸

标签：

原文地址：http://blog.csdn.net/mayuko2012/article/details/42041501