Zodiak

Aplikasi ini merupakan aplikasi zodiak sederhana untuk mengetahui Hari, Bintang, dan Shio berdasarkan tanggal lahir. Aplikasi ini dapat digunakan sebagai referensi bila Anda berminat pada aplikasi ramalan bintang atau sejenisnya.
Download source code-nya disini.

Nama Hari dari Tanggal

Berikut ini merupakan fungsi yang digunakan untuk mengetahui nama hari dari suatu tanggal. Misalnya tanggal 26/09/2010, maka nama harinya adalah Minggu.

Buat Module baru dan ketikkan :

Public Function Hari(ByVal Tanggal As Date) As String
Select Case Weekday(Tanggal)
Case 1: Hari = "Minggu"
Case 2: Hari = "Senin"
Case 3: Hari = "Selasa"
Case 4: Hari = "Rabu"
Case 5: Hari = "Kamis"
Case 6: Hari = "Jum'at"
Case 7: Hari = "Sabtu"
End Select
End Function

Contoh penggunaannya :

s = Hari(CDate("Tanggal"))

Sebenarnya ada cara yang lebih singkat, tetapi hasil nilainya tergantung settingan bahasa di komputer. Kodenya adalah :

s = Format(CDate("Tanggal"), "dddd")

Status Form

Kode berikut ini akan membantu untuk mengetahui status dari Form, apakah sudah di-load (dibuka) atau belum.

Buat Module baru dan ketikkan :
[ VB 6.0 ]

Public Function IsLoaded(ByVal FormName As String) As Boolean
Dim i As Integer
IsLoaded = False
For i = 0 To Forms.Count - 1
If LCase(Forms(i).Name) = LCase(FormName) Then
IsLoaded = True
Exit Function
Exit For
End If
Next
End Function

[ VB .NET ]

Public Function IsLoaded(ByVal FormName As String) As Boolean
Dim i As Integer
IsLoaded = False
For i = 0 To Application.OpenForms.Count - 1
If Application.OpenForms.Item(i).Name.ToLower = FormName.ToLower Then
IsLoaded = True
Exit Function
Exit For
End If
Next
End Function

Untuk penggunaannya, misalkan Anda ingin mengecek status dari 'Form2', contoh kodenya sebagai berikut :

If IsLoaded("Form2") = True Then
'jika sudah di Load
Else
'jika belum di Load
End If

Mengaktifkan Num, Caps, Scroll Lock

Berikut ini adalah kode yang digunakan untuk mengaktifkan atau menonaktifkan Num Lock, Caps Lock, dan Scroll Lock pada keyboard.

Di bagian '(Declarations)' dari Form ketikkan :

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Integer, ByVal dwExtraInfo As Integer)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Integer) As Integer
Private Const kNumLock = 144
Private Const kCapsLock = 20
Private Const kScrollLock = 145

Berikut cara penggunaannya untuk Num Lock :

keybd_event kNumLock, &H45, 1 Or 0, 0
keybd_event kNumLock, &H45, 1 Or 2, 0

Untuk Caps Lock :

keybd_event kCapsLock, &H45, 1 Or 0, 0
keybd_event kCapsLock, &H45, 1 Or 2, 0

dan untuk Scroll Lock :

keybd_event kScrollLock, &H45, 1 Or 0, 0
keybd_event kScrollLock, &H45, 1 Or 2, 0

Untuk memeriksa aktif tidaknya, berikut contoh kodenya (untuk Num Lock) :

If CBool(GetKeyState(kNumLock)) = True Then
'jika aktif
Else
'jika non aktif
End If

Form Kedip

Form kedip adalah form yang titlebar-nya (judul di taskbar) berkedip-kedip. Form kedip biasanya digunakan untuk menarik perhatian User agar mengaktifkan form tersebut. Berilkut cara membuatnya :

Buat Form baru dengan sebuah kontrol Timer(Enabled=True; Interval=500) didalamnya.

[ VB 6.0 ]
Di bagian '(Declarations)' dar Form ketikkan :

Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long

Di bagian 'Timer1_Timer' ketikkan :

If GetActiveWindow <> Me.hwnd Then 'jika form tidak aktif
FlashWindow Me.hwnd, 1
Else
'jika form aktif
End If

[ VB .NET ]
Di bagian '(Declarations)' dar Form ketikkan :

Private Declare Function GetActiveWindow Lib "user32" () As Integer
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Integer, ByVal bInvert As Integer) As Integer

Di bagian 'Timer1_Tick' ketikkan :

If GetActiveWindow <> Me.Handle.ToInt32 Then 'jika form tidak aktif
FlashWindow(Me.Handle.ToInt32, 1)
Else
'jika form aktif
End If
End Sub

Untuk peng-aktif/nonaktif-an pengedipan Form, Anda tinggal merubah properti 'Enabled' pada kontrol Timer.

Mengganti Password MS Access

Berikut ini adalah cara yang digunakan untuk mengganti password database MS Access.

Tambahkan References "Microsoft DAO 3.6 Object Library"

[ VB 6.0 ]

Dim de As New DAO.DBEngine
Dim db As DAO.Database
Dim LokFile As String, Pwd As String

On Error GoTo Ero

LokFile = "Gantikan dengan lokasi file MS Access"
Pwd = "Password Lama"

Set db = de.OpenDatabase(LokFile, True, False, ";pwd=" & Pwd)
db.NewPassword Pwd, "Password Baru"

Exit Sub
Ero:
MsgBox Err.Description

[ VB .NET ]

Dim de As New dao.DBEngine
Dim db As dao.Database
Dim LokFile, Pwd As String

Try
LokFile = "Gantikan dengan lokasi file MS Access"
Pwd = "Password Lama"

db = de.OpenDatabase(LokFile, True, False, ";pwd=" & Pwd)
db.NewPassword(Pwd, "Password Baru")

Catch ex As Exception
MsgBox(ex.Message)
End Try

Compact and Repair MS Access

Bagi Anda yang sudah mengenal MS Access tentu tahu fasilitas "Compact and Repair". Kalau diartikan ke dalam Bhs. Indonesia, kata "Compact and Repair" berarti memadatkan dan memperbaiki. Berikut cara yang digunakan untuk mengakses fasilitas tersebut :

Tambahkan References "Microsoft Access XX.0 Object Library".

[ VB 6.0 ]

Dim acApp As New Access.Application
Dim LokFile As String

LokFile = "Gantikan dengan lokasi file MS Access"

Name LokFile As LokFile & ".tmp" 'create temp

acApp.CompactRepair LokFile & ".tmp", LokFile 'process

Kill LokFile & ".tmp" 'delete temp

[ VB .NET ]

Dim acApp As New Microsoft.Office.Interop.Access.Application
Dim LokFile As String

LokFile = "Gantikan dengan lokasi file MS Access"

Rename(LokFile, LokFile & ".tmp")

acApp.CompactRepair(LokFile & ".tmp", LokFile) 'process

Kill(LokFile & ".tmp") 'delete temp

CATATAN :
Untuk mencegah kesalahan yang mungkin terjadi, backup dulu file databasenya.
Sebelum melakukan proses Compact and Repair, pastikan tidak ada koneksi yang aktif ke file database. Dan juga tidak ada aplikasi lain yang mengakses file database tersebut.

Memainkan Suara Tanpa Kontrol

Jika Anda ingin memutar suara dengan durasi / waktu yang pendek, seperti suara penekanan tombol, efek dalam game, atau pesan notifikasi. Sebenarnya tidak harus menggunakan kontrol player, cukup menggunakan sebuah fungsi pun bisa.

[ VB 6.0 ]
Ketik kode berikut di bagian '(Declarations)' dari Form :

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Untuk menggunakannya ketikkan :

sndPlaySound "Lokasi File WAV", 1

[ VB .NET ]

My.Computer.Audio.Play("Lokasi File WAV")

CATATAN : Untuk kelancaran, gunakan hanya file yang berformat WAV (*.wav)

Memeriksa Eksistensi File dan Folder

Berikut ini adalah cara untuk memeriksa eksistensi atau ada tidaknya suatu file atau folder dalam komputer.

[ VB 6.0 ]
Kode memeriksa eksistensi File sebagai berikut :

Set b = CreateObject("Scripting.FileSystemObject")
If b.FileExists("Lokasi File") = True Then
'jika file eksis
End If

Kode memeriksa eksistensi Folder sebagai berikut :

Set b = CreateObject("Scripting.FileSystemObject")
If b.FolderExists("Lokasi Folder") = True Then
'jika folder eksis
End If

[ VB .NET ]
Kode memeriksa eksistensi File sebagai berikut :

If System.IO.File.Exists("Lokasi File") = True Then
'jika file eksis
End If

Kode memeriksa eksistensi Folder sebagai berikut :

If System.IO.Directory.Exists("Lokasi Folder") = True Then
'jika folder eksis
End If

Mempermudah ADO.NET

Apakah Anda sering dibuat pusing bahkan repot dengan ADO.NET ? Mungkin yang baru mengenal tentang Database akan menjawab 'Ya', karena dipusingkan dengan istilah-istilah seperti 'DataAdapter, 'DataTable', 'DataRow, dll. Apalagi yang sudah pernah mengerjakan sebuah Aplikasi kompleks, yang kebanyakan akan mendeklarasikan beberpa variabel di tiap prosedurnya. Sebenarnya hanya dengan menambahkan sebuah Module, penggunaan ADO.NET dapat dipermudah, bahkan bisa lebih mudah dari ADO klasik yang biasa dikenal dalam VB 6.0 .

Buat sebuah Module dan ketikkan :

Public Function ConString() As String
ConString = ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=D:/KTP.mdb")
End Function

Public Function SQLTable(ByVal Source As String) As DataTable
Try
Dim Adp As New OleDb.OleDbDataAdapter(Source, ConString)
Dim DT As New DataTable

Adp.Fill(DT)
SQLTable = DT
Catch ex As OleDb.OleDbException
MsgBox(ex.Message)
SQLTable = Nothing
End Try
End Function

Public Function ExecSQL(ByVal SQLCommand As String) As Boolean
Dim Con As New OleDb.OleDbConnection
Dim Cmd As New OleDb.OleDbCommand

Try
Con.ConnectionString = ConString()
Con.Open()

Cmd.CommandText = SQLCommand
Cmd.Connection = Con
Cmd.ExecuteNonQuery()

Con.Close()

ExecSQL = True
Catch ex As OleDb.OleDbException
MsgBox(ex.Message)
ExecSQL = False
If Con.State = ConnectionState.Open Then Con.Close()
End Try
End Function

Dapat dilihat Module tersebut memiliki 3 fungsi, antara lain :

1. Fungsi 'ConString', fungsi ini menentukan ConnectionString dari Database. Pastikan fungsi ini bernilai benar, karena fungsi ini menetukan kedua fungsi lainnya. Dari contoh diatas dapat dilihat bahwa Database-nya bertipe MS Access 2003 yang berlokasi di 'D:/KTP.mdb' .
2. Fungsi 'SQLTable', fungsi ini untuk mendefinisikan perintah SQL 'Select' yang biasanya digunakan untuk memilih atau menyeleksi data. Fungsi ini mengembalikan nilai bertipe DataTable, sehingga dapat mudah dikoneksikan dengan kontrol-kontrol.
3. Fungsi 'ExecSQL', fungsi digunakan untuk mengeksekusi perintah SQL 'Insert'(menambahkan), 'Update'(memperbarui), dan 'Delete'(menghapus). Fungsi ini mengembalikan nilai bertipe Boolean, dimana jika perintah SQL berhasil dilakukan maka bernilai True, tapi bila gagal akan bernilai False.

Contoh penggunaannya :

• Mengisi DataGrid.
  
  DataGridView1.DataSource = SQLTable("select * from tblOrang")
• Mengisi ComboBox atau ListBox dengan Field tertentu.
  
  Dim DR As DataRow
  For Each DR In SQLTable("select Nama from tblOrang").Rows
  ComboBox1.Items.Add(DR("Nama"))
  Next
• Mengisi beberapa TextBox.
  
  Dim DR As DataRow
  DR = SQLTable("select * from tblOrang").Rows(0)
  TextBox1.Text = DR("Nama")
  TextBox2.Text = DR("Alamat")
• Mengekekusi perintah 'Insert' untuk menambahkan data.
  
  ExecSQL("insert into tblOrang (ID, Nama, Alamat) values ('17','Joko','Lamongan')")