Home | Looking for something? Sign In | New here? Sign Up | Log out

Rabu, 09 Januari 2013

Contoh Listing VB 6.0 membuat Program peminjaman buku

Rabu, 09 Januari 2013
1 komentar


DATA BUKU 
 
LISTING PROGRAM :

Private Sub CMDBATAL_Click()
NONAKTIF
BERSIH
CMDTAMBAH.SetFocus
End Sub

Private Sub CMDHAPUS_Click()
On Error GoTo errhapus

Dim a As String
a = MsgBox("Yakin Mau Hapus ?", vbInformation + vbYesNo, "Data Buku")
    If a = vbYes Then
        Data1.Recordset.Delete
        MsgBox "Data Telah Dihapus !", vbInformation + vbOKOnly, "Data Buku"
    Else
        NONAKTIF
        BERSIH
        CMDTAMBAH.SetFocus
    End If
    Exit Sub
   
errhapus:
MsgBox "Data Gagal Menghapus !", vbCritical + vbOKOnly, "Data Buku"
End Sub

Private Sub CMDKELUAR_Click()
Dim a As String
a = MsgBox("Yakin Mau Keluar ?", vbInformation + vbYesNo, "Data Buku")
    If a = vbYes Then End
End Sub

Sub BERSIH()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Text = ""
Next ctrl
End Sub

Sub AKTIF()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Enabled = True
Next ctrl
End Sub

Sub NONAKTIF()
Dim ctrl As Control
For Each ctrl In Me
If TypeOf ctrl Is TextBox Then ctrl.Enabled = False
Next ctrl
End Sub

Sub SIMPAN()
Data1.Recordset!kdbuku = TKODE.Text
Data1.Recordset!judul = TJUDUL.Text
Data1.Recordset!author = TAUTHOR.Text
Data1.Recordset!jumlah = TJUMLAH.Text
Data1.Recordset.Update
End Sub

Sub TAMPIL()
TKODE.Text = Data1.Recordset!kdbuku
TJUDUL.Text = Data1.Recordset!judul
TAUTHOR.Text = Data1.Recordset!author
TJUMLAH.Text = Data1.Recordset!jumlah
End Sub

Private Sub CMDSIMPAN_Click()
On Error GoTo errsimpan

Data1.Recordset.AddNew
SIMPAN
NONAKTIF
BERSIH
CMDTAMBAH.SetFocus
Exit Sub

errsimpan:
MsgBox "Data Gagal Disimpan !", vbCritical + vbOKOnly, "Data Buku"
End Sub

Private Sub CMDTAMBAH_Click()
AKTIF
BERSIH
TKODE.SetFocus
End Sub




Private Sub CMDUBAH_Click()
On Error GoTo erredit

If CMDUBAH.Caption = "&UBAH" Then
    AKTIF
    TAMPIL
    CMDUBAH.Caption = "&UPDATE"
Else
    Data1.Recordset.Edit
    SIMPAN
    NONAKTIF
    BERSIH
    CMDUBAH.Caption = "&UBAH"
End If
Exit Sub

erredit:
MsgBox "Data Gagal Diedit !", vbCritical + vbOKOnly, "Data Buku"
End Sub

Private Sub Form_Load()
NONAKTIF
TKODE.MaxLength = 5
TJUDUL.MaxLength = 30
TAUTHOR.MaxLength = 20
TJUMLAH.MaxLength = 4
End Sub


TRANSAKSI

LISTING :


Private Sub CmdBatal_Click()
TxtNo.Enabled = False
TxtJudul.Enabled = False
TxtNama.Enabled = False
DTPicker2.Enabled = False
BERSIH
CmdTambah.SetFocus
End Sub


Private Sub CmdKeluar_Click()
Unload Me
End Sub

Private Sub CmdSimpan_Click()
If DBCombo1.Text = "" Or DBCombo2.Text = "" Then
    MsgBox "Lengkapi Dahulu !", vbCritical + vbOKOnly, "Perhatian"
Else
    With Data3.Recordset
    .AddNew
    .Fields(0) = TxtNo.Text
    .Fields(1) = DBCombo1.Text
    .Fields(2) = DBCombo2.Text
    .Fields(3) = DTPicker1.Value
    .Fields(4) = DTPicker2.Value
    .Update
    MsgBox "Data Berhasil Disimpab!", vbInformation + vbOKOnly, "Perhatian"
    End With
    CmdBatal_Click
End If
End Sub

Private Sub CmdTambah_Click()
AUTO
DBCombo1.SetFocus
End Sub

Private Sub DBCombo1_Change()
Data1.RecordSource = "select*from buku where kdbuku like '" & DBCombo1.Text & "'"
Data1.Refresh
    If Data1.Recordset.RecordCount <> 0 Then
        TxtJudul.Text = Data1.Recordset.Fields(1)
        Data1.RecordSource = "select*from buku"
        Data1.Refresh
    End If
End Sub

Private Sub DBCombo2_Change()
Data2.RecordSource = "select*from anggota where kdanggota like '" & DBCombo2.Text & "'"
Data2.Refresh
    If Data2.Recordset.RecordCount <> 0 Then
        TxtNama.Text = Data2.Recordset.Fields(1)
        Data2.RecordSource = "select*from anggota"
        Data2.Refresh
    End If
End Sub

Private Sub DTPicker1_Change()
DTPicker2.Value = Val(DTPicker1.Value) + 4
End Sub

Private Sub Form_Load()
TxtNo.Enabled = False
TxtJudul.Enabled = False
TxtNama.Enabled = False
DTPicker2.Enabled = False
End Sub

Sub AUTO()
Dim a As String
If Data3.Recordset.RecordCount > 0 Then
Data3.Recordset.MoveLast
a = Right(Data3.Recordset.Fields(0), 3) + 1
If a < 10 Then
TxtNo.Text = "T" & "-" & "00" & a
ElseIf a < 100 Then
TxtNo.Text = "T" & "-" & "0" & a
End If
Else
TxtNo.Text = "T" & "-" & "001"
End If
End Sub

Rub BERSIH()
TxtNo.Text = ""
DBCombo1.Text = "-Pilih-"
TxtJudul.Text = ""
DBCombo2.Text = "-Pilih-"
TxtNama.Text = ""
End Sub

LOGIN
LISTING :

Private Sub CmdBatal_Click()
End
End Sub

Private Sub CmdLogin_Click()
Data1.RecordSource = "select*from user where kduser like '" & TxtNama.Text & "'"
Data1.Refresh
    If Data1.Recordset.RecordCount <> 0 Then
        If TxtNama.Text = Data1.Recordset.Fields(0) _
            And TxtPassword.Text = Data1.Recordset.Fields(2) Then
                If Data1.Recordset.Fields(3) = "User" Then
                    MsgBox "Password Diterima ^_^", vbInformation + vbOKOnly, "Perhatian"
                    FrmMenuUtama.Show
                    FrmMenuUtama.Tb.Enabled = False
                    Unload Me
                Else
                    MsgBox "Password Diterima ^_^", vbInformation + vbOKOnly, "Perhatian"
                    FrmMenuUtama.Show
                    FrmMenuUtama.St.Panels(2) = Data1.Recordset.Fields(1)
                    FrmMenuUtama.St.Panels(3) = Data1.Recordset.Fields(3)
                    Unload Me
                End If
            End If
    Else
        MsgBox "User Tidak Ditemukan !", vbCritical + vbOKOnly, "Perhatian"
        TxtNama.Text = ""
        TxtPassword.Text = ""
        TxtNama.SetFocus
    End If
End Sub

Private Sub TxtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtPassword.SetFocus
End Sub

Private Sub TxtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then CmdLogin_Click
End Sub


MENU UTAMA
LISTING :

Private Sub Form_Load()
St.Panels(1).Text = "Perpustakaan Pintar ^_^"
End Sub

Private Sub LDA_Click()
LapAnggota.Show
End Sub

Private Sub LDB_Click()
LapBuku.Show
End Sub

Private Sub LDT_Click()
LapTransaksi.Show
End Sub
Private Sub Tb_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key

    Case "buku"
    FrmBuku.Show vbModal
   
    Case "anggota"
    FrmAnggota.Show vbModal
   
    Case "transaksi"
    FrmTransaksi.Show vbModal
   
    Case "keluar"
    a = MsgBox("Yakin Mau Mengakhiri Program Perpustakaan ini ?", vbQuestion + vbOKCancel, "Perpustakaan")
        If a = vbOK Then End
   
End Select
End Sub

Private Sub Timer1_Timer()
St.Panels(4).Text = Date
St.Panels(5).Text = Time
End Sub

read more

Membuat Program Faktorial Dengan Vb 6.0

0 komentar

a.    Buatlah New Project pada software VB anda kemudian tambahkan tiga buah label, tiga commandbutton dan dua textbox pada form. Kemudian ubah properti masing-masing dan Atur form seperti pada gambar berikut :

program faktorial dengan VB 6.0
Gambar Program faktorial
b.    kemudian ketikkan code/listing/script program berikut :
Private Sub Command1_Click()
Dim a, b, i As Integer
i = 1
b = Text1.Text
For a = 1 To b
i = i * a
Next
Text2.Text = i
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End Sub

Private Sub Command3_Click()
End
End Sub
c.     Run(F5) dan coba masukkan nilai faktorial 4 dimana 4!=1x2x3x4=24 berikut dapat anda lihat hasilnya pada gambar dibawah ini :
contoh program matematika dengan VB
Gambar Program faktorial dengan VB 6.0
contoh 2 : Membuat Program Penghitung Determinan dan Penjumlahan, Perkalian Matriks Berordo 2x2 dengan VB 6.0
a.    Buatlah New Project pada software VB anda kemudian tambahkan 5 buah label, tiga commandbutton, 13 textbox dan 3  optionbutton pada form. Kemudian ubah properti masing-masing dan Atur form seperti pada gambar berikut :
program matriks dan determinan dengan VB 6.0
Gambar Program Determinan, penjumlahan dan perkalian matriks dengan VB
b.    kemudian ketikkan code/listing/script program berikut :
Private Sub Command1_Click()
If Option2.Value = True Then
Text12.Text = Val(Text1.Text) + Val(Text8.Text)
Text11.Text = Val(Text2.Text) + Val(Text7.Text)
Text10.Text = Val(Text3.Text) + Val(Text6.Text)
Text9.Text = Val(Text4.Text) + Val(Text5.Text)
ElseIf Option3.Value = True Then
Text13.Text = (Val(Text1.Text) * Val(Text4.Text) - Val(Text2.Text) * Val(Text3.Text)) + (Val(Text8.Text) * Val(Text5.Text) - Val(Text7.Text) * Val(Text6.Text))
Else
Text12.Text = (Val(Text1.Text) * Val(Text8.Text)) + (Val(Text2.Text) * Val(Text6.Text))
Text11.Text = (Val(Text1.Text) * Val(Text7.Text)) + (Val(Text2.Text) * Val(Text5.Text))
Text10.Text = (Val(Text3.Text) * Val(Text8.Text)) + (Val(Text4.Text) * Val(Text6.Text))
Text9.Text = (Val(Text3.Text) * Val(Text7.Text)) + (Val(Text4.Text) * Val(Text5.Text))
End If
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text1.SetFocus
End Sub

Private Sub Command3_Click()
End
End Sub
c.     Silahkan run(F5) program anda coba masukkan nilai pada matrhks A dan matriks B kemudian pilih salah satu option lalu tekan tombol proses,,selamat mencoba !
program aplikasi matriks dan determinan dengan VB
Gambar Program Determinan, penjumlahan dan perkalian matriks dengan VB 6.0

read more
Related Posts Plugin for WordPress, Blogger...
 

Contoh Pilihan

SMS GRATIS

Like Box