如何使用 Visual Basic 6.0 创建自动壁纸更换器

下载 chwallpaper_src.zip - 159.46 KB

在 Visual Basic 中设计应用程序非常简单。
单击位于左侧工具栏的所需组件（控件）
并在窗体上的适当位置绘制它。
窗体上的组件对齐到矩形网格，提供
您的应用程序对称的外观。

此应用程序使用以下组件

- 命令按钮
- 单选按钮
- 复选框
- 水平滚动条
- 框架
- 图像控件
- 列表框
- 定时器
- 标签

更改壁纸更改模式

在此处选择应用程序将如何更改桌面壁纸。
可以选择让应用程序自动更改
壁纸，或者可以通过单击
“设置为壁纸”按钮手动操作。

Private Sub optMode_Click(Index As Integer)
	Select Case Index
	Case 0: optMode(0).Value = True
	Case 1: optMode(1).Value = True
	End Select
End Sub

                        
If optMode(0).Value = True Then
    
           
        '***********************
        
If optSeq(0).Value = True Then

     cnt = cnt + 1
     Frame5.Caption = " Wallpapers  ( " & MaxWallpaperFiles & "  files ) " & MaxWallpaperFiles - cnt & "  to go "
      'CurrentWallpaperFile = DoneWallpaperFiles(cnt)
       CurrentWallpaperFile = Int(MaxWallpaperFiles * Rnd)
     List1.ListIndex = CurrentWallpaperFile
     'If (DoneFileCount > MaxWallpaperFiles) Then

	     If (cnt > MaxWallpaperFiles - 1) Then
	     cnt = 0
	      ' DoneFileCount = 0
	      GenerateRandomFile

     End If

End If
        
 

设置壁纸更改顺序

壁纸的顺序可以随机进行或
按非随机的向前顺序排列。
该应用程序生成一系列随机数，将它们存储在
一个数组中。这样做是为了确保数字不会
像使用随机函数时那样经常重复出现。

Private Sub optSeq_Click(Index As Integer)
Select Case Index
      Case 0:
                optSeq(0).Value = True
                optSeq(1).Value = False
                autoMode = True
      Case 1:
                optSeq(1).Value = True
                optSeq(0).Value = False
                autoMode = False
   End Select
End Sub

     If optSeq(1).Value = True Then
             
            
            
             List1.ListIndex = CurrentWallpaperFile
             FileName1 = DriveLetter & WallpaperFile(CurrentWallpaperFile).Path & WallpaperFile(CurrentWallpaperFile).Name
             Image1.Picture = LoadPicture(FileName1)
    
            
             If (CurrentWallpaperFile > MaxWallpaperFiles - 1) Then CurrentWallpaperFile = 0
             Frame5.Caption = " Wallpapers  ( " & MaxWallpaperFiles & "  files ) " & (MaxWallpaperFiles - 1) - CurrentWallpaperFile & "  to go "
                 
                 
                 Else
                
                 'DoneFileCount = DoneFileCount + 1
                 'CurrentWallpaperFile = DoneWallpaperFiles(DoneFileCount)
            
    
       
             
         End If

调整壁纸更改时间

默认时间和最大时间设置为 30 秒，但可以
使用滚动条将其缩短到 2 秒。

Private Sub HScroll1_Change()
    Timer1.Interval = HScroll1.Value
    Label10.Caption = " " & Timer1.Interval / 1000 & " seconds"
    WallpaperChangeInterval = HScroll1.Value
End Sub

程序的循环

< alt="Screenshot - wall06_timer.jpg" src="wallpaperchanger/wall06_timer.jpg" />

此应用程序的核心已放置在 Timer1 中
以尽可能简单。

Private Sub Timer1_Timer()

        '********************
        '**                **
        '********************
        On Error Resume Next
        
        TimerStart = Timer
        
         'Delay = ((TimeDelay / 1000) - (TimerElap - TimerStart)) * 1000
          Delay = TimeDelay - Int(((TimerElap - TimerStart)) * 1000)
        
        '***********************
                        
If optMode(0).Value = True Then
    
           
        '***********************
        
        If optSeq(0).Value = True Then
        
             cnt = cnt + 1
             Frame5.Caption = " Wallpapers  ( " & MaxWallpaperFiles & "  files ) " & MaxWallpaperFiles - cnt & "  to go "
              'CurrentWallpaperFile = DoneWallpaperFiles(cnt)
               CurrentWallpaperFile = Int(MaxWallpaperFiles * Rnd)
             List1.ListIndex = CurrentWallpaperFile
             'If (DoneFileCount > MaxWallpaperFiles) Then
             
             If (cnt > MaxWallpaperFiles - 1) Then
             cnt = 0
              ' DoneFileCount = 0
              GenerateRandomFile
                              
             End If
        
        End If
        
        '***********************
       If optSeq(1).Value = True Then
             
            
            
             List1.ListIndex = CurrentWallpaperFile
             FileName1 = DriveLetter & WallpaperFile(CurrentWallpaperFile).Path & WallpaperFile(CurrentWallpaperFile).Name
             Image1.Picture = LoadPicture(FileName1)
    
            
             If (CurrentWallpaperFile > MaxWallpaperFiles - 1) Then CurrentWallpaperFile = 0
             Frame5.Caption = " Wallpapers  ( " & MaxWallpaperFiles & "  files ) " & (MaxWallpaperFiles - 1) - CurrentWallpaperFile & "  to go "
                 
                 
                 Else
                
                 'DoneFileCount = DoneFileCount + 1
                 'CurrentWallpaperFile = DoneWallpaperFiles(DoneFileCount)
            
    
       
             
         End If
     
     ChangeWallpaper
     CurrentWallpaperFile = CurrentWallpaperFile + 1
         
     If (CurrentWallpaperFile > MaxWallpaperFiles - 1) Then CurrentWallpaperFile = 0
     
       
     'DoneFileCount = DoneFileCount + 1
     'MsgBox DoneFileCount & ".  " & DoneWallpaperFiles(DoneFileCount) & " opps"
      
    End If
     
End Sub

当一切都完成后
(当代码运行时)

浏览壁纸并
选择壁纸文件夹。

显然，如果没有此功能，此应用程序将毫无用处。 浏览
包含壁纸的文件夹非常简单。 选择
包含“bmp 文件”的文件夹，然后单击“确定”按钮。
应用程序将在列表框中列出在目录中找到的所有 bmp 文件
位于窗体的左下部分。

通过单击相关文件来选择文件，
将呈现 .bmp 文件的预览。
单击“设置为壁纸”将将其设置为壁纸，或者
可以单击“自动”单选按钮以使应用程序
自动设置壁纸。



下载源代码：下载 chWallpaper_src.zip - 198.03 KB