Listing Program
1. Loading Option Explicit Dim iSplash As Integer
Private Sub Timer1_Timer() On Error Resume Next iSplash = iSplash + 5 ProgressBar1.Value = ProgressBar1.Value + 400 / 400 If iSplash > 500 Then Timer1.Enabled = False Screen.MousePointer = vbNormal Me.WindowState = 0 Do Me.Left = Me.Left + 20 Me.Move Me.Left, Me.Top DoEvents Loop Until Me.Left > Screen.Width Load frmHome frmHome.Show Unload Me End If End Sub
2. Home Private Sub mnuabout_Click() frmAbout.Show
Universitas Sumatera Utara
End Sub
Private Sub mnugerindo_Click() frmGerindo.Show End Sub
Private Sub mnuhelp_Click() frmVideo.Show End Sub
Private Sub mnuindoger_Click() frmIndoger.Show End Sub
3. Indoger Private Sub cmdDelete_Click() Dim strDelete As String
strDelete = "Delete from IndoToGer Where Idno = " & gintIdItem.Text & "" gAdoConn.Execute strDelete PopData (strTextSearch) txtword.Text = "" txtMeaning.Text = ""
End Sub
Private Sub cmdNew_Click() txtword.Text = "" txtMeaning.Text = ""
Universitas Sumatera Utara
End Sub
Private Sub cmdSave_Click() Dim strSQL As String Dim rs As ADODB.Recordset
If txtword.Text = "" Then MsgBox "Enter the word. ", vbExclamation, "Alert" Exit Sub End If If txtMeaning.Text = "" Then MsgBox "Enter the meaning of word.", vbExclamation, "Alert" Exit Sub End If
strSQL = "Insert into IndoToGer(Istilahkata,Katadesc)Values('" & SQLSafe(txtword.Text) & "','" & _ SQLSafe(txtMeaning.Text) & "')" gAdoConn.Execute (strSQL)
PopData (strTextSearch) txtword.Text = "" txtMeaning.Text = "" End Sub
Private Sub Command1_Click() Dim Istilahkata, Makna As String
Universitas Sumatera Utara
txtMeaning.Text.Clear txtsearch1.Text = UCase("" & txtsearch1.Text & "") Open "Kamus.mdb" For Input As #1 Do Until EOF(1) Input #1, Istilahkata, Makna If UCase(Istilahkata) Like txtsearch1.Text Then Set LI = ListView1.ListItems.Add(, , Istilahkata) LI.SubItems(1) = Makna
End If Loop Close #1
End Sub
Private Sub Form_Load() InitConnection PopData (strTextSearch) End Sub
Private Sub lstView1_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim intSelItem As Integer
intSelItem = Item
txtword.Text = lstView1.ListItems(intSelItem).ListSubItems(1).Text txtMeaning.Text = lstView1.ListItems(intSelItem).ListSubItems(2).Text
Universitas Sumatera Utara
gintIdItem = lstView1.ListItems(intSelItem).ListSubItems(3).Text
End Sub
Private Sub mnuabout_Click() frmAbout.Show End Sub
Private Sub mnuExit_Click() End End Sub
Private Sub InitConnection() Dim conDBString As String
conDBString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Kamus.mdb"
Set gAdoConn = New ADODB.Connection gAdoConn.ConnectionString = conDBString gAdoConn.Open
End Sub
Private Sub PopData(strTextSearch As String)
Dim lstX1 As ListItem Dim strSQL As String Dim rs As ADODB.Recordset
Universitas Sumatera Utara
Dim intCounter As Integer If strTextSearch = "" Then strSQL = "select * from IndoToGer Order by Istilahkata asc" Else strSQL = "Select * from IndoToGer Istilahkata " & _ "where Istilahkata like '%" & strTextSearch & "%' order by Istilahkata asc"
End If
Set rs = New ADODB.Recordset rs.Open strSQL, gAdoConn, 3, 1
lstView1.ListItems.Clear With rs If .RecordCount > 0 Then .MoveFirst intCounter = 1 While Not .EOF Set lstX1 = lstView1.ListItems.Add(, , intCounter) lstX1.ListSubItems.Add = Trim(!Istilahkata) lstX1.ListSubItems.Add = Trim(!Katadesc) lstX1.ListSubItems.Add = Trim(!Idno) intCounter = intCounter + 1 .MoveNext Wend
Universitas Sumatera Utara
End If End With End Sub
Private Sub txtsearch1_Change() PopData (txtsearch1.Text)
End Sub
4. Gerindo Private Sub cmdDelete_Click() Dim strDelete As String
strDelete = "Delete from GerToIndo Where Id = " & gintIdItem.Text & "" gAdoConn.Execute strDelete PopData (strTextSearch) txtWord.Text = "" txtMeaning.Text = ""
End Sub
Private Sub cmdNew_Click() txtWord.Text = "" txtMeaning.Text = "" End Sub
Private Sub cmdSave_Click()
Universitas Sumatera Utara
Dim strSQL As String Dim rs As ADODB.Recordset
If txtWord.Text = "" Then MsgBox "Enter the word. ", vbExclamation, "Alert" Exit Sub End If If txtMeaning.Text = "" Then MsgBox "Enter the meaning of word.", vbExclamation, "Alert" Exit Sub End If
strSQL = "Insert into GerToIndo(Istilah,IstilahDesc)Values('" & SQLSafe(txtWord.Text) & "','" & _ SQLSafe(txtMeaning.Text) & "')" gAdoConn.Execute strSQL
PopData (strTextSearch) txtWord.Text = "" txtMeaning.Text = ""
End Sub
Private Sub Form_Load() InitConnection
Universitas Sumatera Utara
PopData (strTextSearch) End Sub
Private Sub lstView_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim intSelItem As Integer
intSelItem = Item
txtWord.Text = lstView.ListItems(intSelItem).ListSubItems(1).Text txtMeaning.Text = lstView.ListItems(intSelItem).ListSubItems(2).Text gintIdItem = lstView.ListItems(intSelItem).ListSubItems(3).Text
End Sub
Private Sub mnuabout_Click() frmAbout.Show End Sub
Private Sub mnuExit_Click() End End Sub
Private Sub InitConnection() Dim conDBString As String
Universitas Sumatera Utara
conDBString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Kamus.mdb"
Set gAdoConn = New ADODB.Connection gAdoConn.ConnectionString = conDBString gAdoConn.Open
End Sub
Private Sub PopData(strTextSearch As String)
Dim lstX As ListItem Dim strSQL As String Dim rs As ADODB.Recordset
Dim intCounter As Integer If strTextSearch = "" Then strSQL = "select * from GerToIndo Order by Istilah ASC" Else strSQL = "Select * from GerToIndo Istilah " & _ "where Istilah like '%" & strTextSearch & "%' order by Istilah asc"
End If
Set rs = New ADODB.Recordset rs.Open strSQL, gAdoConn, 3, 1
lstView.ListItems.Clear
Universitas Sumatera Utara
With rs If .RecordCount > 0 Then .MoveFirst intCounter = 1 While Not .EOF Set lstX = lstView.ListItems.Add(, , intCounter) lstX.ListSubItems.Add = Trim(!Istilah) lstX.ListSubItems.Add = Trim(!IstilahDesc) lstX.ListSubItems.Add = Trim(!ID) intCounter = intCounter + 1 .MoveNext Wend End If End With End Sub
Private Sub txtSearch_Change() PopData (txtSearch.Text)
End Sub
5. Video Private Sub Form_Load() Me.Top = (Screen.Height - Height) / 5 Me.Left = (Screen.Width - Width) / 2
Universitas Sumatera Utara
Timer1.Interval = 1 WindowsMediaPlayer1.URL = "d:\Kamus Digital Jerman\video tutorial.mp4" End Sub
Private Sub Timer1_Timer() If Me.Left <= 100 Then Timer1.Interval = 0 Else Me.Left = Me.Left - 100 End If
End Sub
Private Sub Timer2_Timer() If Me.Left >= Screen.Width Then Unload Me Else Me.Left = Me.Left + 100 End If
End Sub
6. About
Private Sub cmd_tutup_Click() Unload Me
Universitas Sumatera Utara
End Sub
Private Sub cmd_exit_Click() Unload Me End Sub
Private Sub Cmd_visitme_Click() ShellExecute hWnd, "open", "https://www.facebook.com/groups/165080463525418/", vbNullString, vbNullString, 1 End Sub
Private Sub Form_Load() frmHome.Enabled = False Me.Icon = frmHome.Icon Text1.Top = 2000 Timer1.Interval = 50 End Sub
Private Sub Form_Unload(Cancel As Integer) frmHome.Enabled = True End Sub
Private Sub Timer1_Timer() Dim gerak gerak = Text1.Top - 20 Text1.Top = gerak
If gerak < -2500 Then
Text1.Top = 2090
Universitas Sumatera Utara
End If End Sub
Universitas Sumatera Utara
DEPARTEMEN PENDIDIKAN NASIONAL UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM Jl. Bioteknologi No.1 Kampus USU Padang Bulan Medan-20155 Telp. (061) 8211050, Fax. (061) 8214290
KARTU BIMBINGAN TUGAS AKHIR MAHASISWA Nama Mahasiswa
: IKHSAN AKMAL S
Nomor Stambuk
: 102406151
Judul Tugas Akhir
: Aplikasi Kamus Digital Bahasa Jerman Menggunakan Visual Basic 6.0
Dosen Pembimbing
: Dra. Elly Rosmaini, M.Si
Tanggal Mulai Bimbingan
:
Tanggal Selesai Bimbingan :
No.
Tanggal Asisten Bimbingan
Pembahasan pada Asistensi Mengenai, pada Bab :
Paraf Dosen Pembimbing
Keterangan
1 2 3 4 5 6
Kartu ini harap dikembalikan ke Departemen Matematika bila bimbingan telah selesai.
Diketahui,
Disetujui,
Ketua Departemen Matematika USU
Pembimbing Utama/ Penanggung Jawab
Prof. Dr. Tulus, M.Si NIP. 19640109 198803 1 004
Dra. Elly Rosmaini, M.Si NIP. 19600520 198503 2 002
Universitas Sumatera Utara
SURAT KETERANGAN Hasil Uji Program Tugas Akhir
Yang bertanda tangan di bawah ini, menerangkan bahwa Mahasiswa Tugas Akhir Program Diploma 3 Teknik Informatika :
Nama
: IKHSAN AKMAL S
NIM
: 102406151
Program Studi
: Teknik Informatika
Judul Tugas Akhir
: Aplikasi Kamus Digital Bahasa Jerman Menggunakan Visual Basic 6.0
Telah melaksanakan tes program Tugas Akhir Mahasiswa tersebut di atas pada tanggal :
Juni 2013
Dengan Hasil : SUKSES / GAGAL
Demikian diterangkan untuk digunakan melengkapi syarat pendaftaran Ujian Meja Hijau Tugas Akhir Mahasiswa bersangkutan di Departemen Matematika FMIPA USU Medan.
Medan,
Juni 2013
Dosen Pembimbing / Kepala Lab. Komputer Program Studi D-3 Teknik Informatika
Dra. Elly Rosmaini, M.Si NIP. 19600520 198503 2 002
Universitas Sumatera Utara
