Source code ini merupakan source code yang saya dapatkan dari sebuah website di argentina .
Berikut adalah keterangan dari Source Code ScreenLogger yang saya ambil dari websitenya dan sudah saya terjemahkan dengan bantuan Google Terjemahan .

ScreenLogger adalah alat bagi mereka yang ingin melacak apa yang terjadi pada PC, misalnya untuk orang tua yang takut anak-anak mereka mungkin aneh, untuk pacar atau pacar cemburu / sebagai, atau untuk bisnis yang perlu membawa pengawasan beberapa. Alat ini menghasilkan file video.avi dari segala sesuatu yang terjadi pada layar meringkas paling penting, ketika Anda mengklik atau menekan tombol, berkat ini akhir video adalah ukuran berkurang. Mengenai pemrograman yang bersangkutan, saya terpasang akhirnya hanya modul screenlogger versi sederhana, link download pertama adalah aplikasi selesai.

Screenshoot

Bagi sobat yang ingin source code Screen Longger ini silahkan download bawah .

DOWNLOAD

Terima Kasih ..

Fungsi ini digunakan untuk membuat form kita dapat mengikuti setiap gerak mouse .
Berikut adalah caranya :

Untuk melihat selengkapnya mengenai Cara Membuat Form Mengikuti Mouse dengan Visual Basic, bisa lihat selengkapnya DISINI .

Terima Kasih,

Hari ini saya lebih sering postingin tentang software. Nah, software kali ini tentang diri anda ..
Mau tau? ya apalagi selain untuk menghitung berat badan ideal anda .

Aplikasi ini dibuat dari Microsoft Visual Basic ..
Berikut deskripsi yang saya ambil dari situsnya .

Aplikasi ini cocok untuk membantu posyandu bidan-bidan , dokter, dan  rumah sakit,dan lain-lainaplikasi ini telah memakai multi bahasa..jadi bisa dipakai dinegara manapun ^^
Update :- settingan bahasa sudah dapat disimpan jadi jika yg kita pilih bahasa inggris, maka jika diclose dan dibuka lagi akan tetap bahasa inggris- Skin yang bervariasi

Update :

versi 1.0 :

- settingan bahasa sudah dapat disimpan jadi jika yg kita pilih bahasa inggris, maka jika diclose dan dibuka lagi akan tetap bahasa inggris

- Skin yang bervariasi

versi 2.0 ( NEW ) :

- bahasa lebih banyak

- tampilan yang profesional

- segala jenis error yang ada di versi 1.0 telah diperbaiki

tanpa panjang lebar lansung saja download di bawah ini :

download:

[ Versi 2.0 ]

NOTE : untuk windows 7/8, jalankan melalui run As Administrator

Dibawah ini merupakan contoh kode sehingga kita bisa memahami KeyWord ByVal dan ByRef . Untuk itu, copas code dibawah ini :

Option Explicit

Private Sub Form_Load()
    Dim iNumber As Integer
    iNumber = 1
    MsgBox TampilkanPesan(iNumber)
End Sub

Function TampilkanPesan(ByVal Pesan As String) As String
    TampilkanPesan = Pesan
End Function

Coba bedakan dengan yang ini
Fungsinya akan menampilkan error yakni argumen yang tidak sama (cocok/mismatch)

Private Sub Form_Load()
    Dim iNumber As Integer
    iNumber = 1
    MsgBox TampilkanPesan(iNumber)
End Sub

Function TampilkanPesan(Pesan As String) As String
    TampilkanPesan = Pesan
End Function

Untuk mengatasi error di atas maka cocokan saja argumennya yakni
dengan mengubah variable iNumber yang asalnya integer menjadi String

Private Sub Form_Load()
    Dim iNumber As String
    iNumber = 1
    'sekarang tidak akan terjadi error karena type datanya sama yakni string
    MsgBox TampilkanPesan(iNumber)
End Sub

Function TampilkanPesan(Pesan As String) As String
    TampilkanPesan = Pesan
End Function

Atau Anda beri statement ByVal pada argumen fungsinya

Private Sub Form_Load()
    'Dim iNumber As String
    iNumber = 1
    'sekarang tidak akan terjadi error karena type datanya sama yakni string
    MsgBox TampilkanPesan(iNumber)
End Sub

Function TampilkanPesan(ByVal Pesan As String) As String
    TampilkanPesan = Pesan
End Function

Maka kesimpulannya:

• Secara default Visual Basic 6.0 telah menyertakan ByRef pada argumen walaupun kita tidak menuliskannya, terkecuali secara explicit kita menuliskan ByVal pada argumen tersebut.
• Penggunaan ByVal akan memaksa sebuah argumen untuk dijadikan data type tertentu sebagai contoh:
• ByVal Pesan As String maka pesan akan dipaksa untuk memiliki data type string.
• Penggunaan KeyWord ByVal menjadikan sebuah argumen tidak lagi memiliki hubungan dengan variable yang melewatinya. Sebagai contoh:

    Dim i as integer
    i = 1
    Msgbox TampilkanPesan(i)
    Msgbox i 'maka i disini, tetap saja memiliki nilai satu.

Function TampilkanPesan(ByVal Pesan As String) As String
    Pesan = 2
    TampilkanPesan = Pesan
End Function

Semoga bermanfaat

Pernahkah anda menggunakan kamus 2.04 (Kamus Bahasa Inggris)? disana terdapat object richtexbox yang menerjemahkan bahasa inggris secara warna warni. Kamus tersebut dibuat dengan pemograman delphi .Nah, bagaimana kalau richtextbox di buat menggunakan pemograman visual basic 6.0?
Di bawah ini merupakan contoh format RTF untuk keperluan pembuatan kamus Bahasa Inggris. Fungsi di bawah ini dapat bekerja dengan sangat cepat, mengapa? karena ia tidak memformat tulisan pada objeknya secara langsung akan tetapi, memformat string yang terdapat dalam memori kemudian mem-feed-nya kembali ke dalam objek RichTextBox.

Bukankah:

Private Sub Command1_Click()
Dim i As Integer
For i = 1 To 1000
  Text1.Text = Text1.Text & "contoh tulisan" & vbCrLf
Next
End Sub

Berbeda dengan kode di bawah ini:

Private Sub Command1_Click()
Dim i As Integer
Dim sText As String
sText = Text1.Text
For i = 1 To 1000
  sText = sText & "contoh tulisan" & vbCrLf
Next
Text1.Text = sText
End Sub

Sepintas dua kode di atas akan memberikan hasil yang sama akan tetapi berbeda jauh dalam segi kecepatan.

Di bawah ini merupakan fungsi format RTF untuk pembuatan kamus bahasa inggris:

Option Explicit

Public Function FormatSentence(sSentence As String) As String
Dim sFormat As String
Dim sKosakata As String
Dim sText As String
Dim i As Integer
sFormat = "{\rtf1\fbidis\ansi\ansicpg1256\deff0\deflang1025{\fonttbl{\f0\fswiss\fcharset0 Arial;}}" & vbCrLf & _
"{\colortbl ;\red128\green0\blue0;\red0\green0\blue255;\red0\green128\blue128;\red0\green0\blue128;\red255\green0\blue0;\red128\green0\blue128;}" & vbCrLf & _
"{\*\generator Msftedit 5.41.15.1512;}\viewkind4\uc1\pard\ltrpar\lang1033\f0\fs17"
sKosakata = sSentence
sText = " " & Text1.Text
sText = Replace(sText, vbCrLf, " \Par" & vbCrLf)
sText = Replace(sText, " kb. ", " \cf2\b kb. \cf0\b0 ")
sText = Replace(sText, " -kki. ", " \cf5\b kki. \cf0\b0 ")
sText = Replace(sText, " kk. ", " \cf1\b kk. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0  ")
sText = Replace(sText, " -ks. ", " \cf3\b -ks. \cf0\b0 ")
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, "(", "\cf5(\cf0 ")
sText = Replace(sText, ")", "\cf5)\cf0 ")
For i = 1 To 100
  If InStr(1, sText, i) Then
      sText = Replace(sText, " " & i & " ", " \b " & i & " \cf0\b0 ")
  End If
Next
sText = Replace(sText, " -kkt. ", " \cf5\b -kkt. \cf0\b0 ")
sText = Replace(sText, " ks. ", " \cf3\b ks. \cf0\b0 ")
sText = sFormat & "\b " & sKosakata & "\b0 " & sText & "\par" & vbCrLf & "}"
FormatSentence = sText
End Function

Private Sub Form_Load()
RTF.BackColor = RGB(241, 243, 241)
End Sub

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click()
RTF.TextRTF = FormatSentence(Text2.Text)
End Sub

Maka hasilnya seperti gambar di bawah ini:

Catatan:
Fungsi di atas hanyalah sekadar contoh, Anda dapat memodifikasinya untuk disesuaikan dengan kebutuhan.

Dalam membuat sebuah program, terkadang kita membutuhkan nama path yang disingkat, adapun tujuannya, agar nama yang berada pada paling akhir dapat dibaca. lagi pula kalau tidak disingkat, mungkut akan menemukan MRU.

Untuk menyingkat nama path, kita membutuhkan fungsi API PathCompactPathEx. Berikut code untuk menyingkat nama path :

Option Explicit 
 
Private Declare Function PathCompactPathEx Lib "shlwapi.dll" Alias "PathCompactPathExA" ByVal pszOut As String, ByVal pszSrc As String, ByVal cchMax As Long, ByVal dwFlags As Long) As Long 
 'simpan dalam modul 
Public Function ShortFilePath(FilePath As String, Optional MaxLen As Long = 40) As String 
    Dim ShortPath As String 
    On Error Resume Next 
    ShortPath = String(255, 0) 
    PathCompactPathEx ShortPath, FilePath, MaxLen, 0 
    ShortFilePath = ShortPath 
End Function 

Contoh penggunaan prosedur di atas:

Private Sub Form_Load() 
    Text1.Text = ShortFilePath("F:\Project\Outlook Bar control + Photoshop Color Picker v1.3.2\3. Samples\Images") 
    'akan menghasilkan "F:\Project\Outlook Bar   con...\Images" 
End Sub 

Semoga Bermanfaat ..

Apa yang dimaksud artikel spin/spin artikel/article spinner? bisa Anda baca di sini. Dengan kata lain artikel spin adalah mengganti kata dengan menggunakan sinonim dari kata tersebut secara besar-besaran. Tujuannya? Mengecoh mesin pencari agar artikel yang kita duplikatkan (copy paste) berubah menjadi sebuah konten unik menurut pengamatan robot/mesin pencari (bukan menurut pengamatan manusia). Contoh:

Apa yang dimaksud artikel spin/spin artikel/article spinner? bisa Anda baca di sini. Dengan kata lain artikel spin adalah mengganti kata dengan menggunakan sinonim dari kata tersebut secara besar-besaran. Tujuannya? Mengecoh mesin pencari agar artikel yang kita duplikatkan (copy paste) berubah menjadi sebuah konten unik menurut pengamatan robot/mesin pencari (bukan menurut pengamatan manusia). Contoh:

Saya akan pergi ke pasar. berubah menjadi
Ana berencana berangkat ke pasar. atau
Ane mau pergi ke pasar. atau
Aku berencana pergi ke pasar. atau
Gue akan berangkat ke pasar. atau
gw mo pergi ke pasar. atau
dan seterusnya. dan seterusnya.

Bukankah seluruh kalimat di atas tersebut unik menurut versi mesin pencari? Nah, bagaimana menurut versi manusia (saya dan Anda)?

Spin artikel bisa dikategorikan sebagai sebuah teknik SEO yang sedikit hitam yang dapat menyebabkan banyaknya duplikasi konten/sampah menurut pengamatan manusia. Tetapi dalam dunia sales online/reseller/affeliate hal ini tidak bisa dihindari. Ya saya ulangi, dalam dunia sales online hal ini tidak bisa dihindari. Satu produk dengan merk yang sama dijual oleh ribuah atau jutaan orang secara online.

Di bawah ini merupakan contoh kode spin artikel bahasa indonesia dengan menggunakan 5 kata dan sinonimnya (seharusnya 5000 kata beserta sinonimnya), yakni saya, pergi, blogger, gmail, akan.

Option Explicit 
 
Private Function ChooseWord(choice As Variant, bWord, Optional bUnik As Boolean) As String 
 
    Dim i As Integer 
    Dim strSpin() As String, strChooseWord As String 
    strSpin = Split(choice, ",") 
    If Not bUnik Then 
        Randomize 
        i = CInt((UBound(strSpin) * Rnd) + 1) 
        strChooseWord = strSpin(i - 1) 
    Else 
        Do 
            Randomize 
            i = CInt((UBound(strSpin) * Rnd) + 1) 
            strChooseWord = strSpin(i - 1) 
        Loop While strChooseWord = bWord 
    End If 
    ChooseWord = strChooseWord 
 
End Function 
 
Private Sub cmdDoSpin_Click() 
    Dim strResult As String 
    Dim strSource As String 
    strResult = txtResult.Text 
    strSource = txtSource.Text 
 
    strResult = LCase(strSource) 
 
    Dim arrWord() As String 
    ReDim arrWord(4) 'gantilah menjadi 40, 400, atau 4000 
    'apabila algoritmanya telah dimodif dan mantap maka 
    'tambahkan sinonim menjadi 40, 400, atau 4000 
    arrWord(0) = "saya, aku, ane, ana" 
    arrWord(1) = "pergi, berangkat" 
    arrWord(2) = " akan, berencana" 
    arrWord(3) = "blogger, blogspot, blog milik google (blogspot)" 
    arrWord(4) = "gmail, gmail.com, google mail, layanan email milik google (gmail)" 
    '-------------------------------------------------------- 
    Dim i As Integer, k As Integer 
 
    For i = LBound(arrWord) To UBound(arrWord) 
        Dim strSpin() As String 
        strSpin = Split(arrWord(i), ",") 
        For k = LBound(strSpin) To UBound(strSpin) 
            If InStr(1, strSource, strSpin(k)) > 0 Then 
                strResult = Replace(strResult, strSpin(k), ChooseWord(arrWord(i), strSpin(k), Check1.Value = 1)) 
                Exit For 
            End If 
        Next 
    Next 
    txtResult.Text = Trim$(strResult) 
End Sub 

Cobalah Anda kembangkan. Semoga kode spin artikel bahasa indonesia di atas bermanfaat. Terima kasih atas kunjungannya.

Berikut adalah Fungsi untuk mengetahui jumlah baris textbox menggunakan fungsi API di visual basic .

<pre class=code>Option Explicit 
 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Private Const EM_GETLINECOUNT = &HBA 
 
Public Function GetLineCount(Txt As TextBox) 
    Dim lngLineCount As Long 
    On Error Resume Next 
    lngLineCount = SendMessageLong(Txt.hwnd, EM_GETLINECOUNT, 0&, 0&) 
    GetLineCount =   Format$(lngLineCount, "##,###") 
End Function</pre> 
Private Sub Command1_Click() 
    MsgBox GetLineCount(Text1) 
End Sub 

Semoga Bermanfaat

Dalam pembuatan apllikasi database, memvalidasi data yang akan di entry sangatlah penting. Apakah tujuan umata validasi entry tersebut ?

• Pertama: Mengarahkan user untuk mengisi form secara benar.
• Kedua: Meminimalisir error yang terjadi
• Ketiga dan seterusnya : Silakan Anda tambahkan.

Dari sekian banyak validasi entry yang umum digunakan, diantaranya adalah validasi empty text, yang digunakan untuk memeriksa apakah text telah terisi atau belum.

Di bawah merupakan kode yang efektif untuk tujuan di atas (kode ini dilengkapi dengan pesan yang spesifik yang diambil dari caption label):

'Fungsi untuk memvalidasi empty text secara massal disertai dengan 
'warning message yang spesifik, simpan kode ini dalam modul 
Public Function IsFilledAll(l As Variant, t As Variant) As Boolean 
    Dim o As Object 
     For Each o In t 
       If Trim(o.Text) = "" Then 
            MsgBox "Maaf, informasi " & Replace(l(o.Index).Caption, "&", "") & " tidak boleh dikosongkan", vbInformation + vbOKOnly, "Perhatian" 
            o.SetFocus 
            Exit For 
       Else 
        IsFilledAll = True 
      End If 
    Next 
End Function 

Contoh penggunaan fungsi di atas:

Option Explicit 'Simpan kode ini pada form untuk mengecek empty text 
Private Sub cmdCheck_click() 
    If Not IsFilledAll(Label1, Text1) Then Exit Sub 'Check apakah terdapat textbox kosong 
    'Jika textbox telah diisi maka lanjutkan pada kode berikutnya 
    MsgBox "Seluruh data telah terisi!", vbInformation, "Terima Kasih" 
End Sub 
 

Semoga Bermanfaat .

Twitter? Siapa tidak kenal dengan Jejaring Sosial ini, semua orang pasti sudah mengenalinya (kecuali bayi baru lahir, haha) .

Ok, langsung saja, Mengenai cara mengirim tweet ke twitter.com menggunakan aplikasi yang dibuat dengan VB6 menggunakan bantuan COM ActiveX yang miskin fitur yang diberi nama TwitterCOM.dll. Sekarang saya mau share mengenai TwitterCOM.dll sebuah COM ActiveX yang miskin fiture, walaupun miskin fitur, akan tetapi dengan menggunakan TwitterCOM.dll maka mengirim tweet ke twitter menjadi sangat mudah, siapapun dapat melakukannya termasuk saya, Anda, ibu-ibu, kakek-kakek, nenek-nenek, anak di bawah umur, balita, bayi, baik pria maupun wanita. Dengan syarat terkoneksi dengan internet dan memiliki akun twitter. That's All. 
Adapun kode untuk mengirim tweet ke twitter adalah sebagai berikut: 

Option Explicit

Private Sub cmdSendTweet_Click()
    Dim t As New Twitter
    With t
        .AccessToken = txtToken.Text
        .AccessTokenSecret = txtAccessTokenSecret.Text
        .ConsumerKey = txtConsumerKey.Text
        .ConsumerSecret = txtConsumerSecret.Text
        .Tweet = txtTweet.Text
        .SendTweet
    End With
    Set t = Nothing
End Sub

Wah, ternyata mengirim tweet ke twitter.com menggunakan VB6, kodenya sederhana beungeut. 
Catatan sangat penting:
Sebelum menggunakan TwitterCOM.dll Anda harus memperoleh 4 key, yaitu:

1. Consumer Key
2. Access Token
3. Consumer Secret
4. Access Token Secret

Sekarang kita sudah tidak membutuhkan UserName dan Password untuk melakukan proses ototirasi dan otentifikasi, karena sejak Desember 2009 Twitter sudah tidak menggunakan lagi Basic Auth dan berpindah ke OAuth 1.0a. 
Anda dapat memperoleh 4 kunci di atas dari App Twitter kemudian aktifkan mode access read-writenya. 
Download: TwitterCOM.dll

Semoga Bermanfaat.

Cara ini merupakan fungsi untuk Mendeteksi DNS Server Secara Otomatis dengan memanfaatkan object wscript .

Function DetectDNSServer() As String

   Dim Output As String

On Error GoTo ErrHandler

   Set objShell = CreateObject("WScript.Shell")
   Set objExecObject = objShell.Exec("%comspec% /c ipconfig /all")
   Output = objExecObject.StdOut.ReadAll()
   Set objExecObject = Nothing
   dns = Trim(Replace(Mid(Output, InStr(InStr(1, Output, "DNS Servers"), Output,    ":") + 1, 15), Chr(13), ""))
   DetectDNSServer = dns
   Exit Function

ErrHandler:

   DetectDNSServer = "127.0.0.1"

End Function

Contoh penggunaan:

Private Sub Form_Load()
   MsgBox DetectDNSServer
End Sub

Kegunaannya:
Pada saat kita membuat applikasi server/client (billing Warnet misalnya), pada applikasi clientnya kita tidak harus satu persatu memasukan IP Address servernya.

Semoga Bermanfaat .

Sering menggunakan webcam? tidak ada salahnya anda membuat aplikasi seperti ini .

Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000
Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER

Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25


Public Declare Function capCreateCaptureWindow _
Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
(ByVal lpszWindowName As String, ByVal dwStyle As Long _
, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long _
, ByVal nHeight As Long, ByVal hwndParent As Long _
, ByVal nID As Long) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long
Dim hCap As Long

Private Sub cmd4_Click()
    Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    With CDialog
        .CancelError = True
        .Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
        .Filter = "Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
        .ShowSave
        sFileName = .FileName
    End With
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
    DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub

Private Sub Cmd3_Click()
    Dim temp As Long
    temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub

Private Sub Cmd1_Click()
    hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub

Private Sub Cmd2_Click()
    Dim temp As Long
    temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub

Private Sub Form_Load()
    cmd1.Caption = "Start &Cam"
    cmd2.Caption = "&Format Cam"
    cmd3.Caption = "&Close Cam"
    cmd4.Caption = "&Save Image"
End Sub

Semoga bermanfaat .

Dibawah ini merupakan procedure yang digunakan untuk menghapus seluruh file di recent document .Untuk keperluan ini digunakan satu fungsi API yakni SHAddToRecentDocs yang terdapat pada shell32.dll.

Option Explicit

Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As Any)

Sub EmptyRecentDocument()
   SHAddToRecentDocs 0, CLng(0)
End Sub

Contoh penggunaan procedure VB6 di atas:

Private Sub Command1_Click()
    EmptyRecentDocument
End Sub

Semoga Bermanfaat .

Berikut ini adalah Fungsi untuk mengganti / merubah desktop wallpaper windows dengan visual basic .

Simaklah kode berikut :

Option Explicit

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

Private Const SPIF_SENDWININICHANGE = &H2
Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPIF_SETDESKWALLPAPER = 20

Public Function ChangeWallPaper(imgFile As String)
    Call SystemParametersInfo(SPIF_SETDESKWALLPAPER, 0&, imgFile, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Function

Contoh penggunaan kode di atas

Private Sub Command1_Click()
    Call ChangeWallPaper("C:\Windows\Blue.bmp")
End Sub

Semoga Bermanfaat

Mengetahui lama Windows atau komputer komputer sangatlah penting bagi aplikasi Tune Up dan lainnya .

Fungsi VB6 untuk mengetahui berapa lama windows telah dijalankan.

Option Explicit

Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Timer1_Timer()
    Text1.Text = Format(GetTickCount, "0") & " milisceconds"
    Text2.Text = Format(GetTickCount / 60000, "0") & " minutes"
End Sub

Semoga Bermanfaat

Fungsi ini mungkin jarang sekali di letakkan di aplikasi-aplikasi tertentu, tapi apa salahnya jika kita mencoba .Berikut adalah cara untuk mengetahui Screen Saver di komputer anda aktif atau tidak .

Ok, sekarang masukkan code berikut di Declarations :

Option Explicit

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_GETSCREENSAVEACTIVE = 16

Private Function IsScreenSaverEnable() As Boolean
  Dim bReturn As Boolean
  Dim bActive As Boolean
  Call SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, vbNull, bReturn, 0)
    IsScreenSaverEnable = bReturn
End Function

Contoh penggunaan fungsi untuk memeriksa apakah screen saver enable

Private Sub Command1_Click()
    MsgBox IsScreenSaverEnable
End Sub

Semoga Bermanfaat .

Setelah beberapa waktu lalu saya memberikan tutorial mengenai Cara Menjadikan Layar Komputer Blank, sekarang saya akan memberikan tutorial mengenai Menonaktifkan Keyboard dan Mouse .





Ketikkan/Copykan code berikut ke dalam form anda :

Option Explicit 
 
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long 
 
Private Sub Command1_Click() 
    Timer1.Enabled = True 
    BlockInput True 
End Sub 
 
'Gunakan kode di bawah, agar komputer Anda tidak usah di restart 
Private Sub Form_Load() 
    Timer1.Interval = 1000 '1 detik 
    Timer1.Enabled = False 
End Sub 
 
'Timer1.Interval = 1000 '1 detik 
Private Sub Timer1_Timer() 
    Static i As Integer 
    i = i + 1 
    If i > 5 Then 'tunggu 5 detik 
        BlockInput False 'aktifkan kembali keyboard dan mouse 
        i = 0 
    End If 
End Sub

Semoga Bermanfaat .

Sudah lama saya tidak mengupdate, dan setelah saya pikir-pikir lagi saya kira saya harus terus mengupdate blog saya ini agar pengunjungnya tetap ramai dan mendapatkan visitor yang lebih banyak lagi .

Tutorial kali ini adalah fungsi untuk menjadikan layar komputer blank .
Berikut codenya :

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const MONITOR_ON = -1&
Private Const MONITOR_LOWPOWER = 1&
Private Const MONITOR_OFF = 2&
Private Const SC_MONITORPOWER = &HF170&
Private Const WM_SYSCOMMAND = &H112

Public Function TurnOnMonitor(hwnd As Long, bFlag As Boolean) As Boolean
  If bFlag Then
      Call SendMessage(hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_ON)
  Else
      Call SendMessage(hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal MONITOR_OFF)
  End If
End Function

Contoh penggunaan kode di atas:

Option Explicit

Private Sub Command1_Click()
  TurnOnMonitor Me.hwnd, False
End Sub

Semoga Bermanfaat .