Open Source Code , Downloading , Sharing , Tutorial

Thursday, 29 September 2016

Sistem Crud Visual Basic 6.0



http://j-coder.blogspot.co.id/
Creative Project By Juwendi.
Coding Crud Untuk Software Bisnis Menggunakan ADODB.
Deklarasi ADODB.
Dim DataBarang As New ADODB.Recordset
Fungsi Load Field Database.
Set DataBarang = New ADODB.Recordset ‘[Penerapan Koneksi]
DataBarang.Open "SELECT * from Barang", con, adOpenDynamic, adLockPessimistic ‘
If DataBarang.State = 1 Then Set DataBarang = Nothing
        DataBarang.CursorLocation = adUseClient
        DataBarang.Open "SELECT * FROM [Barang] ORDER BY [Kode Barang]", con, adOpenDynamic, adLockOptimistic
        DataBarang.Requery
dview
Hapus  Field.
Dim rsHapus As New ADODB.Recordset
If rsHapus.State = 1 Then Set rsHapus = Nothing
rsHapus.Open "SELECT * from [Barang] where [Kode Barang]='" & txtID.Text & "'", con, adOpenDynamic, adLockPessimistic
    With rsHapus 
        If Not .EOF Then
            pesan = MsgBox("Apakah Anda Ingin Menghapusnya ?", vbCritical + vbYesNo, "Hapus?")
                If pesan = vbYes Then
                    .Delete
                    .Requery
                    .Close                   
                End If
                Else
            MsgBox "Data Sudah Dihapus !", vbExclamation + vbOKOnly
        End If
        End With

Edit Field.
Dim rsBarang As New ADODB.Recordset
If rsBarang.State = 1 Then Set rsBarang = Nothing
rsBarang.Open "SELECT * from [Barang] where [Kode Barang] ='" & txtID.Text & "'", con, adOpenDynamic, adLockPessimistic
  
   With rsBarang
        con.BeginTrans
        .Fields(0) = txtID.Text
        .Fields(1) = UCase(txtNama.Text)
        .Update
        .Requery
        con.CommitTrans
        .Close
   End With
Set rsBarang = Nothing
Menyimpan Field.
If txtNama.Text = "" Then
    MsgBox "Mohon Isi Nama Barang !", vbInformation + vbOKOnly
Else
    With DataBarang
        con.BeginTrans
        .AddNew
      .Fields(0) = txtID.Text
        .Fields(1) = UCase(txtNama.Text)
        .Update
        .Requery
        con.CommitTrans
    End With
End If


Mencari Data.
If DataBarang.State = 1 Then Set DataBarang = Nothing
Pencarian = "SELECT * from [Barang] where [Kode Barang] like '" & Trim(txtCari) & "%'"
            DataBarang.Open Pencarian, con, adOpenKeyset, adLockOptimistic
                   lv.ListItems.Clear
dview
Fungsi Listview Ke Textbox.
Private Sub lv_Click()
On Error Resume Next
btnEdit.Enabled = True
btnDelete.Enabled = True
txtID.Text = lv.SelectedItem.Text
Text1.Text = lv.SelectedItem.SubItems(1)
End Sub
Fungsi Penampilan Data Pada Listview .
Private Sub dview()
On Error Resume Next
Do While Not DataBarang.EOF
    Set ls = lv.ListItems.Add(, , DataBarang.Fields(0))
        ls.SubItems(1) = DataBarang.Fields(1)
        DataBarang.MoveNext
Loop
End Sub

Modul Kit Koneksi.
Public con As New ADODB.Connection
Dim cmd As New ADODB.Command
Public rs As New ADODB.Recordset
Public Pencarian  As String
Public rsJumlah As Long

Sub Main()
On Error Resume Next
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & “\Database.mdb”  & "; Persist Security Info=False;"
con.CursorLocation = adUseClient
con.Open
With cmd
    .ActiveConnection = con
    .CommandText = strSQLmarketing
    .CommandType = adCmdText
End With
With rs
    .CursorType = adOpenStatic
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open cmd
End With

Splash.Show
End Sub
Public Function getquantity() As Single
    getquantity = rsJumlah
End Function
Public Function TxtBoxIsEmpty(t As Object, tcounter As Integer) As Boolean
Dim i As Integer
For i = 0 To tcounter - 1
    If t(i).Text = "" Then
        TxtBoxIsEmpty = True
    End If
Next i
End Function
Public Sub Cleartext(t As Object, tcounter As Integer)
Dim i As Integer
For i = 0 To tcounter - 1
    t(i).Text = ""
Next i
End Sub
Public Sub AllowNumbersOnly(KeyAscii As Integer)
Select Case KeyAscii
    Case Asc("0") To Asc("9")
    Case Str("8")
Case Else
    KeyAscii = 0
End Select
End Sub
Public Sub AllowNumbersOnlyDot(KeyAscii As Integer)
Select Case KeyAscii

   Case Asc("0") To Asc("9")
   Case Asc(".")
   Case Str("8")
   Case Else
       KeyAscii = 0
End Select
End Sub
Public Sub LoadForm(ByRef srcForm As Form)
    srcForm.Show
    srcForm.WindowState = vbMaximized
    srcForm.SetFocus
End Sub
Share:

0 comments:

Post a Comment

About Our Blog

Labels