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

Form - form dalam aplikasi banyak kegunaannya antara lain untuk manipulasi data,

Contoh Form Lihat Kartu Secara Banyak

Penggunaan listview control untuk dapat melakukan perubahan memang agak sulit tetapi kalo dilihat hasilnya jadi bagus.

Saya senang menggunakan listview untuk menampilkan data.






Dim StrString As String
Dim Item As ListItem

Private Sub CmdCari_Click()
Dim rs As New ADODB.Recordset
Dim SintakSQL As String

SintakSQL = "Select CardNo, Product_ID, Policy_No, Batch_ID, Batch_Date From tbl_Init " & _
" Where (Batch_ID is Null) and (CardNo>='" & Text1.Text & "') and (CardNo<='" & Text2.Text & "') Order By CardNo Asc"

Set rs = Cnn.Execute(SintakSQL)

If rs.EOF Then
MsgBox "Kartu sudah diberikan nomor Batch"
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
Exit Sub
End If
ListView1.ListItems.Clear
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!CardNo)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbRed
Item.SubItems(1) = rs!Product_ID
Item.SubItems(2) = rs!Policy_No
Item.SubItems(3) = rs!Batch_ID
Item.SubItems(4) = rs!Batch_Date
rs.MoveNext
Loop
jumlah.Caption = "Total : " & _
ListView1.ListItems.Count & " record"
i = ListView1.ListItems.Count
ListView1.ListItems(i).Selected = True

End Sub

Private Sub cmdlagi_Click()
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
Text3.Text = ""
ListView1.ListItems.Clear
End Sub

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

Private Sub CmdSimpan_Click()
Dim rs As New ADODB.Recordset
Dim SintakSQL As String

If Text3.Text <> "" Then

Dim i
For i = 1 To ListView1.ListItems.Count
Set ListView1.SelectedItem = ListView1.ListItems(i)
ListView1.SelectedItem.SubItems(3) = Text3.Text
ListView1.SelectedItem.SubItems(4) = CDate(Now)

SintakSQL = "Update tbl_Init Set " & _
"Batch_ID = '" & Text3.Text & "'," & _
"Batch_Date = getdate()" & _
"Where CardNo ='" & ListView1.SelectedItem & "'"

Cnn.Execute (SintakSQL)
Next i

End If
End Sub

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

AturListView "Kode Kartu", 25, "Kode Produk", 15, _
"Kode Polis", 15, "Nomor Batch", 20, "Tgl Proses Batch", 25

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

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

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


Private Sub Form_Unload(Cancel As Integer)
Call Menu_Bisa
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()
If Text1.Text <> "" Then
Dim Panjang As Byte

Panjang = Len(Trim(Text1.Text))

If Panjang < 10 Then
MsgBox "Nomor Kartu Pulsa Bintang harus 10 digit !!!", vbInformation
Text1.SetFocus
End If
End If
End Sub

Private Sub Text2_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 Text2_LostFocus()
If Text2.Text <> "" Then
Dim Panjang As Byte

Panjang = Len(Trim(Text1.Text))

If Panjang < 10 Then
MsgBox "Nomor Kartu Pulsa Bintang harus 10 digit !!!", vbInformation
Text1.SetFocus
End If
End If
End Sub

Private Sub Text3_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