关于换桌面墙纸的问题

czlyc006 2004-07-22 10:34:31
我想写一个定时自动换桌面墙纸的程序,但不知windows是如何控制墙纸的显示与更换的(程序应该从何入手?)。请知道的同志不吝赐教。
...全文
185 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
dongge2000 2004-07-23
  • 打赏
  • 举报
回复
也就是看看了。SystemParametersInfo的方法是即时有效的,REG的方法是重起后有效的。加一块就可以像窗体-属性-背景,中的一样了。
czlyc006 2004-07-23
  • 打赏
  • 举报
回复
费了不少力气拜读完了各位的高论,收获颇丰,先去试试了!
熊孩子开学喽 2004-07-23
  • 打赏
  • 举报
回复
楼上的方法,果然简单!
yinweihong 2004-07-23
  • 打赏
  • 举报
回复
参考:
http://tech.tom.com/Archive/2002/2/4-95789.html
online 2004-07-22
  • 打赏
  • 举报
回复
你觉得复杂,看简单的
Private Sub Command1_Click()
Dim ChangeWP
text1.text="c:\aaa.bmp"
ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Text1.Text, 0)

MsgBox "墙纸已经更改为" & vbCrLf & "" & vbCrLf & UCase$(Text1.Text) & vbCrLf & "", 64, "Instant Wallpaper Changer"
End Sub

模块
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 Const SPI_SETDESKWALLPAPER = 20
熊孩子开学喽 2004-07-22
  • 打赏
  • 举报
回复
哦,看错了,楼上就一位,不是几位,刚才弄错了。哈哈
熊孩子开学喽 2004-07-22
  • 打赏
  • 举报
回复
楼上的几位高手所用的办法一定比我的好,但是我看不懂,相信楼主也一定看得稀里糊涂,好吧,我们一起来用一个投机取巧的办法吧,一定行的,我自己就是这样用的。
首先楼主用ACDSEE打开随便一个什么图片,把它设为墙纸,最好在显示器属性里改为“平铺”那样比较好看。然后,打开您的资源管理器,找到WINDOWS所在的目录,是否有一个叫“ACD Wallpaper.bmp”的位图文件呢?我们记下它的名字和路径,假设它是“C:\WinNt\ACD Wallpaper.bmp”吧,记住这个东西。
下面,我们打开VB,新建一个工程,加一个PictureBox
属性设置如下:
Picture1.Aperance=0
Picture1.AutoSize=True
Picture1.BorderStyle=0
Picture1.AutoReDraw=True
好了,现在我们在Picture1上加载一个图像文件,比如:
Picture1.Picture = LoadPicture(App.Path & "\111.jpg")
然后我们就把它变成墙纸
SavePicture Picture1.Image ,"C:\WinNt\ACD Wallpaper.bmp"

最后,我们把它写进一个过程里,看得更舒服:
Private Sub Form_Load()
Picture1.Aperance=0
Picture1.AutoSize=True
Picture1.BorderStyle=0
Picture1.AutoReDraw=True
Picture1.Picture = LoadPicture(App.Path & "\111.jpg")
SavePicture Picture1.Image, "C:\WinNt\ACD Wallpaper.bmp"
End Sub
大功告成!哈哈,F5运行!
怎么没有反应?你要重新启动啊,起码也要注销一下吧。
TechnoFantasy 2004-07-22
  • 打赏
  • 举报
回复
本例把一个JPG格式的图片成功地设置为墙纸,全部代码如下:

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

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

Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1
Const REG_SZ As Long = 1
Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long, lPredefinedKey As Long)

 lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0,
             KEY_ALL_ACCESS, hKey)
 lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
 RegCloseKey (hKey)
End Sub

Private Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
 Dim lValue As Long
 Dim sValue As String
 Select Case lType
  Case REG_SZ
     sValue = vValue & Chr$(0)
     SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType,
            sValue, Len(sValue))
  Case REG_DWORD, REG_BINARY
     lValue = vValue
     SetValueEx = RegSetValueExLong(hKey, sValueName, 0&,
            lType, lValue, 4)
 End Select
End Function

Private Sub Form_Load()
'取得windows目录
 Dim Path As String, strSave As String
 strSave = String(50, Chr$(0))
 Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
 '转换图片并保存到Windows目录下面
 Image1.Picture = LoadPicture(App.Path & "\MyFlower.Jpg")
 SavePicture Image1, Path & "\MyFlower.bmp"
 Dim aa As String
 '写入注册表
 '设定居中
 SetKeyValue "Control Panel\desktop", "TileWallpaper",
        "0", REG_SZ, HKEY_CURRENT_USER
 '设定平铺
 ' SetKeyValue "Control Panel\desktop",
         "TileWallpaper", "1", REG_SZ, HKEY_CURRENT_USER
 '更换墙纸
 aa = Path & "\MyFlower.bmp"
 ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, aa, 0)
 '在注册表中记录图片位置
 SetKeyValue "Control Panel\desktop", "Wallpaper", aa,
        REG_SZ, HKEY_CURRENT_USER
End Sub

  使用本例要注意:必须先设置是否"居中",然后再更换墙纸。本例在Windows95+VB6下调试通过。



TechnoFantasy 2004-07-22
  • 打赏
  • 举报
回复
用VB更换桌面墙纸DIY

2001-10-16· ·杜运庆··YESKY


1 2 下一页


  在客户运行您的应用程序的时候自动更换墙纸,显然是广告宣传的一个好机会。但无论是MSDN还是网络上的免费资源代码,更换墙纸几乎都是同一个API函数SystemParametersInfo和同一段代码,国外站点提供的免费代码也是如此。从VB4.0开始就这样。这段代码是:

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
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Const SPIF_UPDATEINIFILE = &H1

Private Sub Form_Load()
  ChangeWP = SystemParametersInfo(SPI_SETDESKWALLPAPER,
         0, "Path+BmpFile", 0)
End Sub

  使用这个例程确实能够切换墙纸,但存在以下问题:

  1、用鼠标右键点击桌面,会看到【背景】→【墙纸】里面的文件名是空的。

  2、重新启动后桌面墙纸消失。

  3、没告诉您怎么切换"居中"或"平铺"。

  怎么解决这些问题呢?

  1、Windows的墙纸必须以BMP格式的文件存放在Windows目录下面,如果您的图片不在该目录或不是BMP文件,那么就会出现第一个问题。因此必须把您的图片转换成BMP文件并复制到Windows目录下面。

  2、要使重新启动后需要在注册表里面修改相应的键值,具体位置是 HKEY_CURRENT_USER\Control Panel\desktop中的Wallpaper键,让它的键值等于您的全路径文件名。

  3、在更换墙纸以前首先设置是否"居中",需要修改注册表中HKEY_CURRENT_USER\Control Panel\desktop中的TileWallpaper键,键值"0"表示"居中","1"表示"平铺"。


程序支持三种更桌面壁纸方式:开机自动更,定时更,热键更(热键可以设置) 只要您指定壁纸文件所在文件夹,程序将该文件夹下(含所有子文件夹)所有的JPEG、GIF、TIF、PNG、JPE、JPG、BMP文件自动随机设置为桌面壁纸,使您的桌面壁纸随时都在变化。如果文件夹下的文件发生变化,程序会自动监控到并进行更新。 1、开机自动更壁纸,前提当然得要将该程序设置为开机自动运行(本程序自动最小化加入到系统托盘)。 2、定时更壁纸,只要您设置了时间间隔并启用定时更功能,即可定时更。 3、手动更,在任何界面下按热键键即可马上更壁纸(默认热键为CTRL+ALT+P,可以在设置中更改)。 本程序系VB2008编写,可在windows XP 及Vista下运行(在XP下需要安装.NET Framework2.0组件,请从微软官方网站下载。 安装方法: 方法一:解压缩后,运行“自动更壁程序.application”即可安装程序,安装完后会在开始菜单建立菜单。 方法二:解压缩后,可以不进行安装,直接运行“Application Files\自动更壁程序_1_0_0_2\自动更壁程序.exe”即可,此时不会在开始菜单建立程序组。 首次运行本程序时,会自动弹出设置窗口,要求您指定壁纸文件所在文件夹等选项。如果您要将程序设置为开机自动运行,请选中“设置为开机自动运行并更壁纸”复选框,取消该复选框则可以取消开机自动运行。 如果您对本程序有何建议或意见,请与本人联系 姓名:游平 地址:湖南省 株洲市 215信箱 财务处 邮编:412002 邮箱:myyouping@hotmail.com

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧