Oleh: admin | 28/10/2011

Source Code Tiket Kapal Penumpang

Source Code yang ada pada Aplikasi Tiket Kapal Penumpang ini sangat mudah dipelajari. jadi, cocok bagi anda kategori programmer tingkat pemula dan lanjut . Berikut screen gambarnya:

Form Utama dan Login


Form Entry Tarif Tiket

Form Entry Nomor Tempat

Form Entry Pesan Tempat

Form Entry Penjualan Tiket

Pada form ini terdapat fasilitas untuk pencarian data calon penumpang yang telah memesan tiket

Output Tiket Kapal

Form Laporan Cetak Penumpang

Ouput Laporan Penumpang

Form lainnya :
– Form User
– Form Backup Database
– Form Pembatalan Tiket
– Form Mengosongkan Tempat
Berikut source code Form Entry Tarif Tiket :

Public Ada1, Valid As Boolean
Dim RsTampil As New ADODB.Recordset
Private Sub Form_Activate()
frmmenuutama.Enabled = False
End Sub
Private Sub Form_Load()
BukaDatabase
tdkaktif
kosong
Tampildata
tutuptombol
xpsimpan.Caption = "&Tambah"
frmmenuutama.stb.Panels(5).Text = "Form Biaya Tiket"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Koneksi.Close
frmmenuutama.stb.Panels(5).Text = "Menu Utama"
End Sub
Private Sub tdkaktif()
txtanak2.Enabled = False: txtpelajar.Enabled = False: txtumum.Enabled = False: txtfasilitas.Enabled = False
End Sub
Private Sub aktif()
txtanak2.Enabled = True: txtpelajar.Enabled = True: txtumum.Enabled = True: txtfasilitas.Enabled = True
End Sub
Private Sub xpkeluar_Click()
Unload Me
frmmenuutama.Enabled = True
End Sub
Private Sub txtjnstiket_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   SendKeys vbTab
   End If
End Sub
Private Sub txtanak2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   SendKeys vbTab
   End If
End Sub
Private Sub txtpelajar_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   SendKeys vbTab
   End If
End Sub
Private Sub txtumum_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   SendKeys vbTab
   End If
End Sub
Private Sub txtfasilitas_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   SendKeys vbTab
   End If
End Sub
Private Sub kosong()
txtanak2.Text = "": txtpelajar.Text = "": txtumum.Text = "": txtfasilitas.Text = ""
End Sub
Private Sub isiformtarif()
txtanak2.Text = Rsbytiket!Anak2: txtpelajar.Text = Rsbytiket!Pelajar
txtumum.Text = Rsbytiket!umum: txtfasilitas.Text = Rsbytiket!fasilitas
End Sub
Private Sub isitblbytarif()
Rsbytiket!jnstiket = txtjnstiket.Text: Rsbytiket!Anak2 = txtanak2.Text: Rsbytiket!Pelajar = txtpelajar.Text
Rsbytiket!umum = txtumum.Text: Rsbytiket!fasilitas = txtfasilitas.Text
End Sub
Private Sub xpsimpan_Click()
If xpsimpan.Caption = "&Tambah" Then
   xpbatal_Click
   Exit Sub
End If
Validasi
If Valid = True Then
    If Ada1 = False Then
       Rsbytiket.AddNew
       isitblbytarif
       Rsbytiket.Update
    Else
      isitblbytarif
      Rsbytiket.Update
    End If
    xpsimpan.Caption = "&Tambah"
Else
xpsimpan.Caption = "&Simpan"
End If
Rsbytiket.Requery
Tampildata
End Sub
Private Sub xphapus_Click()
ckode = Trim(txtjnstiket.Text)
Rsnotempat.Find ("jnstiket='" & ckode & "'"), , adSearchForward, 1
If Not Rsnotempat.EOF Then
   x = MsgBox("jenis tiket tersebut tidak dapat dihapus", 0 + 16, "konfirmasi")
   txtjnstiket.SetFocus
   Exit Sub
Else
   Y = MsgBox("Benar anda ingin hapus ???", vbYesNo + vbQuestion + vbDefaultButton2, "konfirmasi")
    Select Case Y
    Case vbYes
    Koneksi.Execute "delete * from tblbytiket where jnstiket='" & ckode & "'"
    Case vbNo
End Select
End If
xpbatal_Click
Rsbytiket.Requery
Tampildata
End Sub
Private Sub Validasi()
Valid = False
If txtanak2.Text = Empty Then
 x = MsgBox("tarif untuk anak-anak harus diisi", 0 + 16, "konfirmasi")
   txtanak2.Text = ""
   txtanak2.SetFocus
   Exit Sub
ElseIf txtpelajar.Text = Empty Then
 x = MsgBox("tarif untuk pelajar harus diisi", 0 + 16, "konfirmasi")
   txtpelajar.Text = ""
   txtpelajar.SetFocus
   Exit Sub
ElseIf txtumum.Text = Empty Then
 x = MsgBox("tarif untuk penumpang umum harus diisi", 0 + 16, "konfirmasi")
   txtumum.Text = ""
   txtumum.SetFocus
   Exit Sub
ElseIf txtfasilitas.Text = Empty Then
 x = MsgBox("fasilitas harus diisi", 0 + 16, "konfirmasi")
   txtfasilitas.Text = ""
   txtfasilitas.SetFocus
   Exit Sub
End If
Valid = True
End Sub
Private Sub xpbatal_Click()
kosong
tdkaktif
txtjnstiket.Enabled = True
txtjnstiket.SetFocus
xpsimpan.Caption = "&Tambah"
tutuptombol
End Sub
Private Sub xpedit_click()
tutuptombol
Ada1 = True
aktif
txtjnstiket.Enabled = True
xpsimpan.Caption = "&Simpan"
txtanak2.SetFocus
End Sub
Private Sub Tampildata()
Set RsTampil = Nothing
RsTampil.Open "select * from tblbytiket order by jnstiket ", Koneksi, adOpenDynamic, adLockOptimistic
Set Grid1.DataSource = RsTampil
Grid1.Columns(0).Width = 2000
Grid1.Columns(1).Width = 1000
Grid1.Columns(2).Width = 1000
Grid1.Columns(3).Width = 1000
Grid1.Columns(4).Width = 1250
Grid1.Columns(1).Alignment = dbgCenter
Grid1.Columns(2).Alignment = dbgCenter
Grid1.Columns(3).Alignment = dbgCenter
Grid1.Columns(0).Caption = "Tiket"
Grid1.Columns(1).Caption = "Anak-anak"
Grid1.Columns(2).Caption = "Remaja"
Grid1.Columns(3).Caption = "Dewasa"
Grid1.Columns(4).Caption = "Fasilitas"
Grid1.Columns(1).NumberFormat = "#,###,###  "
Grid1.Columns(2).NumberFormat = "#,###,###  "
Grid1.Columns(3).NumberFormat = "#,###,###  "
If RsTampil.RecordCount > 0 Then
   Grid1.Caption = "Biaya Tiket Kapal "
Else
   Grid1.Caption = "ga ada tu datanya "
End If
End Sub
Private Sub txtanak2_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or _
   KeyAscii = vbKeyBack) Then
   KeyAscii = 0
End If
End Sub
Private Sub txtpelajar_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or _
   KeyAscii = vbKeyBack) Then
   KeyAscii = 0
End If
End Sub
Private Sub txtumum_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or _
   KeyAscii = vbKeyBack) Then
   KeyAscii = 0
End If
End Sub
Private Sub txtjnstiket_Lostfocus()
ckode = Trim(txtjnstiket.Text)
If ckode = Empty Then
   Exit Sub
End If
If Rsbytiket.RecordCount > 0 Then
   Rsbytiket.MoveFirst
End If
Set Rsbytiket = Nothing
Rsbytiket.Open "[tblbytiket] where jnstiket ='" & ckode & "'", Koneksi, adOpenDynamic, adLockOptimistic
If Rsbytiket.EOF Then
   kosong
   aktif
   txtanak2.SetFocus
   Ada1 = False
   tutuptombol
   xpsimpan.Caption = "&Simpan"
Else
   tdkaktif
   isiformtarif
   xpedit.Enabled = True
   xphapus.Enabled = True
   Ada1 = True
End If
End Sub
Private Sub tutuptombol()
xpedit.Enabled = False
xphapus.Enabled = False
End Sub

Software Pendukung:
1. Microsoft Visual Basic 6.0
2. Microsoft Acces 2003
3. Crystal Report 8.5

Dapatkan Juga Ebook Cara Pembuatan Aplikasi Tiket Kapal (VIEW EBOOK)
Anda tertarik, hubungi : 085756231035 atau Prima Software

Responses

  1. lumnyan bisa nambah reverensi.. lo bisa tolong di post kode tuk hapus item data tertentu pada komponen msflexgrid

    • suka pake msflexgrid, knapa gk DataGrid atau Listview lebih bagus

  2. ini menggunakan apa? delphi?

    • vb6 gan,,,


Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

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

Kategori

%d blogger menyukai ini: