Source Code VB 6.0 Set Wallpaper Desktop

aper ::. Aplikasi ini digunakan untuk mensetting background desktop. Logika jalannya aplikasi:

1. Mendapatkan alamat wallpaper yang dipilih, kemudian di wallpaper tersebut disalin ke folder Windows dengan nama file Background.bmp
2. Kemudian path wallpaper yang di folder windows, dimasukan ke dalam registry.
   HKEY_CURRENT_USER\Control Panel\Desktop

---

• Setelah komputer dinyalakan. Buka aplikasi VBnya, bila belum ada aplikasi VBnya silakan diinstall terlebih dahulu. Kemudian pilih standard.exe. Kemudian design interfacenya terlebih dulu di form1, seperti di bawah ini.

• setelah itu atur propertinya, biar lebih mudah ikuti properti dibawah ini.

Object	Properties	Value
Form1	BorderStyle Caption MinButton	1 – Fixed Single Set Wallpaper True
Drive1	-	-
Dir1	-	-
File1	Pattern	*.bmp;*.jpg;*.jpeg;*.gif
Image1	BorderStyle Stretch	1 – Fixed Single True
Label1	Caption	Set Position Wallpaper
OptionButton1	Caption	Tile
OptionButton2	Caption	Center
Command1	Name Caption	cmdApply Apply

• setelah properti diatur semua. kemudian masukan coding di bawah ini di form1.

‘<—salin dari sini (Begin)—>

Option Explicit

Dim FileDipilih

Private Sub cmdApply_Click()

On Error Resume Next

‘Save gambar yang dipilih ke Windows

SavePicture Image1.Picture, GetWindowsPath & “Background.bmp”

‘Panggil sub ubah

Ubah

End Sub

Private Sub Drive1_Change()

‘Memilih Drive

Dir1.Path = Drive1.Drive

End Sub

Private Sub Dir1_Change()

‘Mengaitkan daftar file dengan daftar directory

File1.Path = Dir1.Path

End Sub

Private Sub File1_Click()

‘Klik File1, tampilkan gambar

Cls

FileDipilih = File1.Path & “/” & File1.FileName

Image1.Picture = LoadPicture(FileDipilih)

End Sub

Private Sub Ubah()

‘Perintah ubah wallpaper (Setting di Registry)

Dim rtn As Long

Dim KeyName As String

Dim Nilai As String

Dim hKey As Long

Dim KeyValueLength As Long

If Tile.Value = True Then

Nilai = 1

Else

Nilai = 0

End If

KeyName = “desktop\TileWallpaper”

KeyValueLength = Len(Nilai) + 1

rtn = RegOpenKey(HKEY_CURRENT_USER, “Control Panel\desktop”, hKey)

rtn = RegSetValueEx(hKey, “TileWallpaper”, 0, REG_SZ, Nilai, KeyValueLength)

rtn = RegCloseKey(hKey)

rtn = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, _

“Background.bmp”,SPIF_UPDATEINIFILE Or _

SPIF_SENDWININICHANGE)

End Sub

‘<—sampai sini (End)—>

• setelah coding di atas dicopy di form1. Kemudian buat satu module. caranya, klik project di menubar, pilih add module.

• setelah module dibuat. Kemudian masukan coding di bawah ini. di module1.

‘<—salin dari sini (Begin)—>

‘—Api code yang dibutuhkan—

Public Declare Function GetWindowsDirectory Lib “kernel32.dll” Alias _

“GetWindowsDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) _

As Long

Declare Function SystemParametersInfo& Lib “user32″ Alias _

“SystemParametersInfoA” (ByVal uAction&, ByVal uParam&, ByVal lpvParam _

As Any, ByVal fuWinIni&)

Declare Function RegCloseKey Lib “advapi32.dll” (ByVal hKey As Long) As Long

Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” _

(ByVal hKey As Long, ByVal ipSubKey As String, phkResult As Long) As Long

Declare Function RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA” _

(ByVal hKey As Long, ByVal ipSubKey As String, phkResult As Long) As Long

Declare Function RegQueryValue Lib “advapi32.dll” Alias “RegQueryValueA” _

(ByVal hKey As Long, ByVal ipSubKey As String, ByVal ipValue As String, _

ipcbValue As Long) As Long

Declare Function RegSetValueEx Lib “advapi32.dll” Alias “RegSetValueExA” _

(ByVal hKey As Long, ByVal ipValueName As String, ByVal Reserved As Long, _

ByVal dwType As Long, ByVal ipData As String, ByVal cbData As Long) As Long

Public Const REG_SZ = 1

Public Const HKEY_CURRENT_USER = &H80000001

Public Const SPIF_UPDATEINIFILE = &H1

Public Const SPI_SETDESKWALLPAPER = 20

Public Const SPIF_SENDWININICHANGE = &H2

‘—Dapatkan path Windows—

Public Function GetWindowsPath() As String

On Error Resume Next

Dim Buffer As String * 255

Dim x As Long

x = GetWindowsDirectory(Buffer, 255)

GetWindowsPath = Left(Buffer, x) & “\”

End Function

‘<—sampai sini(End)—>

• Setelah diketik semua codingnya di form1 dan di module1 yang diatas, Silakan jalankan project untuk mengetahui hasilnya.

1. Pilih drive melalui DriveListBox,
2. Pilih directory melalui DirListBox,
3. Pilih file gambar yang berformat *.bmp melalui FileListBox,
4. Pilih posisi gambar (Tile atau Center),
5. Klik tombol Apply.

Free Template Blogger collection template Hot Deals BERITA_wongANteng SEO theproperty-developer