form1.frm

可以自动更换墙纸的小程序。此程序用vb来实现

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "自动更换墙纸的小程序"
   ClientHeight    =   4035
   ClientLeft      =   6270
   ClientTop       =   4305
   ClientWidth     =   6930
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4035
   ScaleWidth      =   6930
   Begin VB.Timer Timer1 
      Interval        =   5000
      Left            =   6240
      Top             =   0
   End
   Begin MSComDlg.CommonDialog ComOpen 
      Left            =   3960
      Top             =   3480
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   "bmp"
      Filter          =   "*.bmp|*.bmp|*.*|*.*"
   End
   Begin VB.CommandButton CmdAdd 
      Caption         =   "添加墙纸"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2040
      TabIndex        =   4
      Top             =   3480
      Width           =   1815
   End
   Begin VB.CommandButton CmdExit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4680
      TabIndex        =   3
      Top             =   3480
      Width           =   2175
   End
   Begin VB.CommandButton CmdNow 
      Caption         =   "立即更换"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   3480
      Width           =   1815
   End
   Begin VB.ListBox Listfile 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2985
      Left            =   0
      TabIndex        =   0
      Top             =   360
      Width           =   6855
   End
   Begin VB.Label Label1 
      Caption         =   "从列表框中选择一幅图片，点击“立即更换”设置为墙纸："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   6015
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------------------
'               自动更换墙纸的小程序
'---------------------------------------------
'                洪恩在线  求知无限
'---------------------------------------------
'    SystemParametersInfo函数应用的一个例子
'---------------------------------------------
'【VB声明】
'  Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

'【说明】
'  允许获取和设置数量众多的windows系统参数

'【返回值】
'  Long，非零表示成功，零表示失败。会设置GetLastError

'【备注】
'  在调用这个函数之前，特别要注意将lpvParam参数定义成正确的数据类型

'【参数表】
'  uAction --------  Long，指定要设置的参数。参考uAction常数表

'  uParam ---------  Long，参考uAction常数表
'  lpvParam -------  Any，按引用调用的Integer、Long和数据结构。对于String数据，请用SystemParametersInfoByval函数。具体用法参考uAction常数表

'  fuWinIni -------  Long，取决于不同的参数及操作系统，随同这个函数设置的用户配置参数保存在win.ini或注册表里，或同时保存在这两个地方。这个参数规定了在设置系统参数的时候，是否应更新用户设置参数。可以是零（禁止更新），或下述任何一个常数：
'  SPIF_UPDATEINIFILE
'  更新win.ini和（或）注册表中的用户配置文件
'  SPIF_SENDWININICHANGE
'  倘若也设置了SPIF_UPDATEINIFILE，将一条WM_WININICHANGE消息发给所有应用程序。否则没有作用。这调消息告诉应用程序已经改变了用户配置设置

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
Dim flag As Boolean
'设置墙纸
Const SPI_SETDESKWALLPAPER = 20
'更新windows ini 文件
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2

'当“添加墙纸”按钮被按下时
Private Sub CmdAdd_Click()
'弹出通用对话框（打开文件）
ComOpen.ShowOpen
'如果选择了墙纸图片则把图片的路径添加到列表框中去
Listfile.AddItem ComOpen.FileName
End Sub

'当“退出程序”按钮被按下时，退出
Private Sub CmdExit_Click()
Unload Me
End Sub

'窗体加载时
Private Sub Form_Load()
    'flag为布尔型变量，标示列表框中是否有文件存在
    flag = False
    '设置自动更换墙纸的间隔时间，单位为毫秒，可以改变
    Timer1.Interval = 5000
End Sub

'当经历一定间隔时间，定时器TIMER被唤醒，执行指定任务
Private Sub Timer1_Timer()
    '如果列表框中没有图片，不进行任何操作
    If Listfile.ListCount = 0 Then
    Exit Sub
    '否则把标示flag置为True
    Else: flag = True
    End If
    
    'bmpfile为字符串变量，存储图片路径
    Dim bmpfile As String
    '如果flag为真
    If flag Then
        '从列表框中读取一个文件路径并赋值给bmpfile
        bmpfile = Listfile.List(Listfile.ListIndex)
        '把墙纸更换为bmpfile所指图片，并修改INI文件
        SystemParametersInfo SPI_SETDESKWALLPAPER, 0, bmpfile, SPIF_UPDATEINIFILE
        '如果已经是列表框中最后一张图片，把ListIndex设为0即第一张图片
        If Listfile.ListIndex = Listfile.ListCount - 1 Then
            Listfile.ListIndex = 0
        '否则ListIndex加一，指向下一张图片
        Else
        Listfile.ListIndex = Listfile.ListIndex + 1
        End If
    End If
End Sub

'当“立即更换”按钮被按下时
Private Sub CmdNow_Click()
    Dim bmpfile As String
    '如果列表框中没有图片，不做任何操作
    If Listfile.ListCount = 0 Then End
    '否则把选中的图片更换为墙纸
    bmpfile = Listfile.List(Listfile.ListIndex)
    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, bmpfile, SPIF_UPDATEINIFILE
End Sub