rawallpaper.bas

星子行V2.0(源码)公开星子行V3.0以上版本,都是由星子行V1.0和星子行V2.0的核心结合而开发成的! 星子行V1.0是单反接正法,星子行V2.0是多反接法,星子行V3.0以上版本都是多反

Attribute VB_Name = "Rawallpaper"
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

Public CWallp As String '设置位置

Public Sub Wallpaper_s(Wapr As String)

Dim objWSHShell As Object

Dim a As Integer
Dim b As Integer

Select Case CWallp

Case "Cwallpb"

a = 0
b = 1

Case "Cwallpm"

a = 0
b = 0

Case "Cwallpk"

a = 2
b = 0

End Select

Set objWSHShell = CreateObject("WScript.Shell")

objWSHShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\Wallpaper", Left$(Environ("windir"), 2) & "\Documents and Settings\" & Environ("username") & "\Local Settings\Application Data\Microsoft\Wallpaper1.bmp"
objWSHShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\ConvertedWallpaper", Wapr
objWSHShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\WallpaperStyle", a
objWSHShell.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\TileWallpaper", b '设置位置，2,0为拉伸，0,0为居中，0,1为平铺
Set objWSHShell = Nothing

Main.RaPic.Picture = LoadPicture(Wapr) '"F:\星子行开发工程\星子行(开发)\客户端\1.JPG"
SavePicture Main.RaPic.Picture, Left$(Environ("windir"), 2) & "\Documents and Settings\" & "\" & Environ("username") & "\Local Settings\Application Data\Microsoft\Wallpaper1.bmp"
Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Left$(Environ("windir"), 2) & "\Documents and Settings\" & "\" & CStr(Environ("username")) & "\Local Settings\Application Data\Microsoft\Wallpaper1.bmp", SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)



End Sub

Public Sub Delwall_s()

Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE)

End Sub