Belajar Pemograman Yuuk (VB 6.0, SQL Server, PostgreSQL, PHP)

Form For Manipulation Data, Such Adding data, Delete, Update, Viewing in Listview

Dim StrString As String
Dim Item As ListItem

Private Sub CmdAdd_Click()

ClearTextBox
Text1.Enabled = True
Text1.SetFocus
CmdSave.Enabled = False
CmdUpdate.Enabled = False

End Sub

Private Sub CmdClose_Click()
Unload Me
Set rs = Nothing
Set Cnn = Nothing
End Sub

Private Sub CmdSave_Click()
Dim Msql As String

If Text1.Text = "" Then
MsgBox "Anda tidak diperkenankan mengisi data dengan Branch ID kosong !!!", vbInformation
Else
Cnn.BeginTrans
'Membuat record baru pada tbl_Branch
Set rs = New ADODB.Recordset
'menambah record pada tabel

Msql = " Insert into tbl_Branch(Branch_ID, Branch_Name, Branch_Address, City, Post_Code, Country, Contact_Person, Phone, Fax, Email, BrcnhMobile)" & _
" Values('" & Text1.Text & "','" & Text2.Text & "','" & Text3.Text & "','" & Text4.Text & "','" & Text5.Text & "','" & Text6.Text & "','" & Text7.Text & "','" & Text8.Text & "','" & Text9.Text & "','" & Text10.Text & "','" & Text12.Text & "')"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

Set Item = ListView1.ListItems.Add(, , Text1.Text)
Item.SubItems(1) = Text2.Text
Item.SubItems(2) = Text3.Text
Item.SubItems(3) = Text4.Text
Item.SubItems(4) = Text5.Text
Item.SubItems(5) = Text6.Text
Item.SubItems(6) = Text7.Text
Item.SubItems(7) = Text8.Text
Item.SubItems(8) = Text9.Text
Item.SubItems(9) = Text10.Text
Item.SubItems(10) = Text12.Text
Cnn.CommitTrans
End If

ClearTextBox
CmdSave.Enabled = False

End Sub

Private Sub CmdUpdate_Click()
Dim Msql As String

If Text1.Text <> "" And Text1.Enabled = False Then

Cnn.BeginTrans

'Mengubah record pada tabel
Msql = " Update tbl_Branch Set " & _
" Branch_Name='" & Text2.Text & "'," & _
" Branch_Address='" & Text3.Text & "'," & _
" City='" & Text4.Text & "'," & _
" Post_Code='" & Text5.Text & "'," & _
" Country='" & Text6.Text & "'," & _
" Contact_Person='" & Text7.Text & "'," & _
" Phone='" & Text8.Text & "'," & _
" Fax='" & Text9.Text & "'," & _
" Email='" & Text10.Text & "'," & _
" BrcnhMobile='" & Text12.Text & "'" & _
" Where Branch_ID='" & Text1.Text & "'"

'Mengeksekusi perintah SQL
Cnn.Execute (Msql)

Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text6.Enabled = False
Text7.Enabled = False
Text8.Enabled = False
Text9.Enabled = False
Text10.Enabled = False
Text12.Enabled = False

CmdSave.Enabled = False
CmdUpdate.Enabled = False

Cnn.CommitTrans

End If

End Sub

Private Sub Form_Load()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset

With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog = Pulsa;" & _
"Trusted Connection=yes;User ID=pulsa; Password=Pulsa123"
.Open
End With

rs.CursorLocation = adUseClient
rs.Open "tbl_Branch", Cnn

AturListView "Branch ID", 10, "Branch Name", 35, _
"Address", 80, "City", 20, "Postal Code", 12, "Country", 20, _
"Contact Person", 20, "Phone", 20, "Faximile", 20, "Email", 30, _
"Mobile Number", 20

i = 1
'tidak diperkenankan ada kosong
'Jika ada field kosong error coba difix kan

Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!Branch_ID)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbRed
Item.SubItems(1) = rs!Branch_Name
Item.SubItems(2) = rs!Branch_Address
Item.SubItems(3) = rs!City
Item.SubItems(4) = rs!Post_Code
Item.SubItems(5) = rs!Country
Item.SubItems(6) = rs!Contact_Person
Item.SubItems(7) = rs!Phone
Item.SubItems(8) = rs!Fax
Item.SubItems(9) = rs!Email
Item.SubItems(10) = rs!BrcnhMobile
rs.MoveNext
Loop
Label11.Caption = "Total : " & _
ListView1.ListItems.Count & " record"
i = ListView1.ListItems.Count
ListView1.ListItems(i).Selected = True

'Atur Letak Form
Me.Top = (Main.ScaleHeight - Me.ScaleHeight) / 2
Me.Left = (Main.ScaleWidth - Me.ScaleWidth) / 2

CmdUpdate.Enabled = False
CmdSave.Enabled = False
End Sub

Public Sub AturListView(ParamArray lstView())
Dim i, Lebar

ListView1.View = lvwReport
Lebar = ListView1.Width - 80
With ListView1.ColumnHeaders
.Clear
For i = 0 To UBound(lstView) - 1 Step 2
.Add , , lstView(i), (lstView(i + 1) _
* Lebar) / 100
Next i
End With
Exit Sub
End Sub

Sub ClearTextBox()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text12.Text = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Menu_Bisa
End Sub

Private Sub ListView1_Click()
Dim StrSQl As String
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "tbl_Branch", Cnn

Cnn.BeginTrans
StrSQl = "select Branch_ID from tbl_Branch where Branch_Name='" & ListView1.SelectedItem.ListSubItems.Item(1) & "'"

Set rs = Cnn.Execute(StrSQl)

If ListView1.ListItems.Count = 0 Then
Exit Sub
End If
On Error Resume Next
Text11.Text = ListView1.SelectedItem.Index
Text1.Enabled = False
Text1.Text = rs!Branch_ID
Text2.Text = ListView1.SelectedItem.ListSubItems.Item(1)
Text3.Text = ListView1.SelectedItem.ListSubItems.Item(2)
Text4.Text = ListView1.SelectedItem.ListSubItems.Item(3)
Text5.Text = ListView1.SelectedItem.ListSubItems.Item(4)
Text6.Text = ListView1.SelectedItem.ListSubItems.Item(5)
Text7.Text = ListView1.SelectedItem.ListSubItems.Item(6)
Text8.Text = ListView1.SelectedItem.ListSubItems.Item(7)
Text9.Text = ListView1.SelectedItem.ListSubItems.Item(8)
Text10.Text = ListView1.SelectedItem.ListSubItems.Item(9)
Text12.Text = ListView1.SelectedItem.ListSubItems.Item(10)

CmdSave.Enabled = False
CmdUpdate.Enabled = True
Cnn.CommitTrans
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With ListView1
.SortKey = ColumnHeader.Index - 1
.Sorted = True
If .SortOrder = lvwAscending Then
.SortOrder = lvwDescending
Else
.SortOrder = lvwAscending
End If

End With
End Sub

Private Sub ListView1_DblClick()
'Menghapus record dari listview
Dim i As Integer
Dim TempIndex As Integer
Dim TempKode, StrSQl As String

Set rs = New ADODB.Recordset

If ListView1.ListItems.Count = 0 Then
Exit Sub
End If

TempIndex = ListView1.SelectedItem.Index
TempKode = ListView1.ListItems.Item(TempIndex)
Cnn.BeginTrans

Msql = "Select Branch_ID From tbl_Inst_Agent Where Branch_ID='" & TempKode & "'"

Set rs = Cnn.Execute(Msql)

If Not rs.EOF Then
MsgBox "Anda tidak dapat menghapus record ini !!!" & vbCrLf & "Karena digunakan di tabel lain", vbOKOnly + vbCritical, "Perhatian"
CmdAdd.SetFocus

Else

Konfirmasi = MsgBox("Apakah Anda yakin data " & _
TempKode & vbCrLf & " akan dihapus ??? ", vbYesNo + vbCritical, "Confirm")
If Konfirmasi = vbYes Then

'Menghapus record pada tabel
Msql = "Delete From tbl_Branch" & _
" Where Branch_ID='" & Text1.Text & "'"

i = ListView1.SelectedItem.Index
ListView1.ListItems.Remove i

Cnn.Execute (Msql)
Label11.Caption = "Total Record : " _
& rs.RecordCount

End If
End If

CmdUpdate.Enabled = False
Cnn.CommitTrans
ClearTextBox
Exit Sub

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub Text1_LostFocus()
Dim Msql As String
If Text1.Text <> "" Then
Cnn.BeginTrans

'Mencari Kode pada Tabel
Msql = "Select * From tbl_Branch " & _
" Where Branch_ID='" & Text1.Text & "'"

Set rs = Cnn.Execute(Msql)

'Jika Kode sudah ada tampilkan
If Not rs.EOF Then

'Menampilkan data dalam tabel ke form
On Error Resume Next
Text1.Enabled = False
Text2.Text = rs.Fields("Branch_Name")
Text3.Text = rs.Fields("Branch_Address")
Text4.Text = rs.Fields("City")
Text5.Text = rs.Fields("Post_Code")
Text6.Text = rs.Fields("Country")
Text7.Text = rs.Fields("Contact_Person")
Text8.Text = rs.Fields("Phone")
Text9.Text = rs.Fields("Fax")
Text10.Text = rs.Fields("Email")
Text12.Text = rs.Fields("BrcnhMobile")

CmdAdd.Enabled = True
CmdUpdate.Enabled = True

Else
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text12.Text = ""
CmdSave.Enabled = True
End If

rs.Close

Cnn.CommitTrans

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "+-0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub Text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "+-0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub

Private Sub Text10_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
End If
End Sub

Private Sub Text12_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys vbTab
Else
Dim StrAngka As String
StrAngka = "+-0123456789"

If KeyAscii > 26 Then
If InStr(StrAngka, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End If
End Sub