Source Code VB 6.0 Set Wallpaper Desktop


.:: Set Wallpaper ::.wall1.jpg

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.

wall2.jpg

  • 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.

Catatan:

Anda dapat memodifikasi sendiri codingnya atau tampilan form1 sesuai dengan kreatif masing-masing. (—Selamat Mencoba—)

Iklan

2 pemikiran pada “Source Code VB 6.0 Set Wallpaper Desktop

  1. Boro boro gan tutor nya ajja banyak yang trouble :

    ini mksd nya apa gan :
    Declare Function SystemParametersInfo& Lib “user32? Alias _
    “SystemParametersInfoA” (ByVal uAction&, ByVal uParam&, ByVal lpvParam _
    As Any, ByVal fuWinIni&)

    (blokir tulisan warna merah)

    yang ini juga asal nya tombol ini dari mana ?

    Private Sub Ubah()

    bbrp tulisan ada yang di blokir red juga ! itu kenapa ?

Tinggalkan Balasan

Please log in using one of these methods to post your comment:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s