Aplikasi Kamusku Dengan Visual Basic.06

Disini saya akan sedikit menjelaskan mengenai pembuatan kamus dengan menggunkan Visual basic. ini hasil ideku yang sudah jadi, namun sekarang terbengkalai dikarenakan berbagai hal. aplikasi ini dibuat dengan menggunakan Visual basic 6.0 dan menggunakan database Acces.

Fitur-fitur nya :

• Kamus
• Irregular Verb
• Regular Verb
• Catatan
• Sound saat startup

Tools yang digunakan :

• Frame
• Shapes
• Listbox
• Textbox
• Label
• Images
• Common Button

Seperti ini Screenshoot nya :

Tampilan Startup

Tampilan Depan 

 Tampilan Menu Irregular Verb

Tampilan  Regular Verb

Tampilan Kamus

 Tampilan Catatan

Mari kita lihat kode nya :

1. Code Koneksi dengan Acces Pada Module

'Koneksi Database
Public dbkoneksi As ADODB.Connection
Public Sub Koneksi()
Dim Lokasi As String
    Lokasi = App.Path & "\Database\Kamus.mdb"
Set dbkoneksi = New ADODB.Connection
    dbkoneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Lokasi & "; Persist Security Info=False; Jet OLEDB:Database Password=ahmad"
End Sub

2.  Code Sound Saat Satarup Pada Module
'Memainkan Musik

Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Const SND_ASYNC = &H1
Public Const SND_SYNC = &H0
Public Const SND_LOOP = &H8
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

3. Code Untuk Form StartUp

Private Sub Form_Load()
sndPlaySound App.Path & "\Audio\Masuk.wav", SND_ASYNC
End Sub
Private Sub Timer1_Timer()
Load Form_Utama
Form_Utama.Show
Unload Me
End Sub

4. Code Untuk Kamus

Private Sub OPKamus()
cmbKamus.AddItem "Indonesia"
cmbKamus.AddItem "Inggris"
End Sub
Private Sub cmbCariKamus_Click()
Dim DataComboKamus As String
DataComboKamus = txtKamus.Text
Set RsKamus = New ADODB.Recordset
RsKamus.CursorLocation = adUseClient
If cmbKamus.Text = "Indonesia" Then
    RsKamus.Open "select * from Datakamus where Indonesia like '" & DataComboKamus & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaKamus
    Kamus_View.Refresh
ElseIf cmbKamus.Text = "Inggris" Then
    RsKamus.Open "select * from Datakamus where Inggris like '" & DataComboKamus & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaKamus
    Kamus_View.Refresh
Else
End If
End Sub
Sub JikaKamus()
If (RsKamus.EOF) Then
    MsgBox "Kata Yang Anda Cari Tidak Ditemukan.", vbCritical, "Konfirmasi"
    Else
    Set Kamus_View.DataSource = RsKamus
    FormatViewKamus
    JmlKamus.Caption = "Jumlah Kata : " & RsKamus.RecordCount & ""
End If
End Sub
'Format Penampilan
Private Sub FormatViewKamus()
With Kamus_View
    .ColumnWidth(1) = 243
    .ColumnText(1) = "Indonesia"
    .ColumnAlignment(1) = enAlignCenter
   
    .ColumnWidth(2) = 243
    .ColumnText(2) = "Inggris"
    .ColumnAlignment(2) = enAlignCenter
End With
End Sub
'Tampil Database
Private Sub TampilKamus()
Set RsKamus = New ADODB.Recordset
    RsKamus.Open "select * from Datakamus order by Indonesia", dbkoneksi, adOpenStatic, adLockOptimistic
Set Kamus_View.DataSource = RsKamus
JmlKamus.Caption = "Jumlah Kata : " & RsKamus.RecordCount & ""
End Sub
Private Sub Timer1_Timer()
If Weekday(Date) = 1 Then
    LbTanggal.Caption = "Minggu" & Format(Date, ", dd-mm-yyyy")
ElseIf Weekday(Date) = 2 Then
    LbTanggal.Caption = "Senin" & Format(Date, ", dd-mm-yyyy")
ElseIf Weekday(Date) = 3 Then
    LbTanggal.Caption = "Selasa" & Format(Date, ", dd-mm-yyyy")
ElseIf Weekday(Date) = 4 Then
    LbTanggal.Caption = "Rabu" & Format(Date, ", dd-mm-yyyy")
ElseIf Weekday(Date) = 5 Then
    LbTanggal.Caption = "Kamis" & Format(Date, ", dd-mm-yyyy")
ElseIf Weekday(Date) = 6 Then
    LbTanggal.Caption = "Jum'at" & Format(Date, ", dd-mm-yyyy")
Else
    LbTanggal.Caption = "Sabtu" & Format(Date, ", dd-mm-yyyy")
End If
    LbJam.Caption = Format(Time, "hh:mm:ss")
End Sub 

5. Code Untuk Irregular Verb

'Tampil Database
Private Sub TampilIrregular()
Set RsIrregular = New ADODB.Recordset
    RsIrregular.Open "select * from Irregular order by Infinitive", dbkoneksi, adOpenStatic, adLockOptimistic
Set Irregular_View.DataSource = RsIrregular
JmlIrregular.Caption = "Jumlah Kata : " & RsIrregular.RecordCount & ""
End Sub
'Pencarian Kata
Private Sub cmdCariIrregular_Click()
Dim DataCombo As String
DataCombo = txtIrregular.Text
Set RsIrregular = New ADODB.Recordset
RsIrregular.CursorLocation = adUseClient
If cmbIrregular.Text = "Infinitive (V1)" Then
    RsIrregular.Open "select * from Irregular where Infinitive like '" & DataCombo & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaIrregular
    Irregular_View.Refresh
ElseIf cmbIrregular.Text = "Past Tense (V2)" Then
    RsIrregular.Open "select * from Irregular where Past_Tense like '" & DataCombo & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaIrregular
    Irregular_View.Refresh
ElseIf cmbIrregular.Text = "Past Participle (V3)" Then
    RsIrregular.Open "select * from Irregular where Past_Participle like '" & DataCombo & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaIrregular
    Irregular_View.Refresh
Else
End If
End Sub
Sub JikaIrregular()
If (RsIrregular.EOF) Then
    MsgBox "Kata Yang Anda Cari Tidak Ditemukan.", vbCritical, "Konfirmasi"
    Else
    Set Irregular_View.DataSource = RsIrregular
    FormatViewIrregular
    JmlIrregular.Caption = "Jumlah Data : " & RsIrregular.RecordCount & ""
End If
End Sub
'Format Penampilan
Private Sub FormatViewIrregular()
With Irregular_View
    .ColumnWidth(1) = 120
    .ColumnText(1) = "Invinitive (V1)"
    .ColumnAlignment(1) = enAlignCenter
   
    .ColumnWidth(2) = 120
    .ColumnText(2) = "Past Tense (V2)"
    .ColumnAlignment(2) = enAlignCenter
   
    .ColumnWidth(3) = 120
    .ColumnText(3) = "Past Participle (V3)"
    .ColumnAlignment(3) = enAlignCenter
   
    .ColumnWidth(4) = 126
    .ColumnText(4) = "Arti"
    .ColumnAlignment(4) = enAlignCenter
End With
End Sub
Private Sub OPIrregular()
cmbIrregular.AddItem "Infinitive (V1)"
cmbIrregular.AddItem "Past Tense (V2)"
cmbIrregular.AddItem "Past Participle (V3)"
End Sub

6. Code Untuk Regular Verb

'Tampil Database
Private Sub TampilRegular()
Set RsRegular = New ADODB.Recordset
    RsRegular.Open "select * from Regular order by Infinitive", dbkoneksi, adOpenStatic, adLockOptimistic
Set Regular_View.DataSource = RsRegular
JmlRegular.Caption = "Jumlah Kata : " & RsRegular.RecordCount & ""
End Sub
'Format Penampilan
Private Sub FormatViewRegular()
With Regular_View
    .ColumnWidth(1) = 120
    .ColumnText(1) = "Invinitive (V1)"
    .ColumnAlignment(1) = enAlignCenter
   
    .ColumnWidth(2) = 120
    .ColumnText(2) = "Past Tense (V2)"
    .ColumnAlignment(2) = enAlignCenter
   
    .ColumnWidth(3) = 120
    .ColumnText(3) = "Past Participle (V3)"
    .ColumnAlignment(3) = enAlignCenter
   
    .ColumnWidth(4) = 126
    .ColumnText(4) = "Arti"
    .ColumnAlignment(4) = enAlignCenter
End With
End Sub
Sub JikaRegular()
If (RsRegular.EOF) Then
    MsgBox "Kata Yang Anda Cari Tidak Ditemukan.", vbCritical, "Konfirmasi"
    Else
    Set Regular_View.DataSource = RsRegular
    FormatViewRegular
    JmlRegular.Caption = "Jumlah Kata : " & RsRegular.RecordCount & ""
End If
End Sub
'Pencarian Kata
Private Sub cmdCariregular_Click()
Dim DataComboRegular As String
DataComboRegular = txtRegular.Text
Set RsRegular = New ADODB.Recordset
RsRegular.CursorLocation = adUseClient
If cmbRegular.Text = "Infinitive (V1)" Then
    RsRegular.Open "select * from Regular where Infinitive like '" & DataComboRegular & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaRegular
    Regular_View.Refresh
ElseIf cmbRegular.Text = "Past Tense (V2)" Then
    RsRegular.Open "select * from Regular where Past_Tense like '" & DataComboRegular & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaRegular
    Regular_View.Refresh
ElseIf cmbRegular.Text = "Past Participle (V3)" Then
    RsRegular.Open "select * from Regular where Past_Participle like '" & DataComboRegular & "%'", dbkoneksi, adOpenDynamic, adLockOptimistic
    Call JikaRegular
    Regular_View.Refresh
Else
End If
End Sub

Private Sub OPRegular()
cmbRegular.AddItem "Infinitive (V1)"
cmbRegular.AddItem "Past Tense (V2)"
cmbRegular.AddItem "Past Participle (V3)"
End Sub

 Cukup sekian saja untuk share mengenai pembuatan kamusku.

Sumber : http://www.komputermedia.com