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

Untuk membuat report

Option Explicit
Dim indeks As Integer
Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset

Sub Lihat_Report(laporan As String, saring As String)
With Report1
.LogOnServer "p2ssql.dll", "10.11.12.56", "pulsa", "pulsa", "Pulsa123"
.ReportFileName = App.Path & "\Report\" & laporan & ".rpt"
.WindowState = crptMaximized
.ReportTitle = "Dari tanggal " & dt_dari.Value & " sampai dengan tanggal " & dt_sampai.Value
.SelectionFormula = saring
.Action = 1
.Reset
End With
End Sub

Private Sub cetak_Click()
Select Case indeks
Case 0
'Per-agen
Lihat_Report "per-agen", "{View_Data.kdagen} in '" & agen & "'"
Case 1
'Per-agen Per-periode
Lihat_Report "per-agen2", "{View_Data1.agent_id} in '" & agen & "' and " & _
"{View_Data1.tanggal} IN DATE (" & Format(dt_dari.Value, "YYYY,MM,DD") & ")" & _
"TO DATE (" & Format(dt_sampai.Value, "YYYY,MM,DD") & ")"
Case 2
'Per-cabang
Lihat_Report "per-cabang", "{rptpercabang.kdcab} in '" & cab & "'"
Case 3
'Per-cabang Per-periode
Lihat_Report "per-cabang2", "{View_Data2.kdCab} in '" & cab & "' and " & _
"{View_Data2.tanggal} IN DATE (" & Format(dt_dari.Value, "YYYY,MM,DD") & ")" & _
"TO DATE (" & Format(dt_sampai.Value, "YYYY,MM,DD") & ")"
Case 4
'total-cabang diluar KP
Lihat_Report "total-cab", ""
Case 5
'total-kp saja
Lihat_Report "total-kp", ""
Case 6
'Total-data Per-periode
Lihat_Report "per-periode", "{View_All_Periode.tanggal} IN DATE (" & Format(dt_dari.Value, "YYYY,MM,DD") & ")" & _
"TO DATE (" & Format(dt_sampai.Value, "YYYY,MM,DD") & ")"
Case 7
'Total
Lihat_Report "total", ""
Case 8
'RPP Kantor Pusat Pos Langsung
Lihat_Report "RPP", "{RPP.Branch_ID} in '" & cab & "' and " & _
"{RPP.transc_date} IN DATE (" & Format(dt_dari.Value, "YYYY,MM,DD") & ")" & _
"TO DATE (" & Format(dt_sampai.Value, "YYYY,MM,DD") & ")"
End Select
End Sub

Private Sub Form_Activate()
dt_dari.Value = Format(Now, 1 & "/mmmm/yyyy")
dt_sampai.Value = DateAdd("m", DateDiff("m", 0, Now), 1)
End Sub

Private Sub Form_Load()
'Deklarasikan variabel koneksi
Set Cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rs1 = 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_Agent", Cnn
rs1.Open "tbl_Branch", Cnn

agen.Clear: cab.Clear
Dim Msql As String
Msql = "SELECT Agent_ID FROM tbl_Agent ORDER BY Agent_ID"
While Not rs.EOF
agen.AddItem rs!Agent_ID
rs.MoveNext
Wend

Msql = "SELECT Branch_ID FROM tbl_Branch"
While Not rs1.EOF: cab.AddItem rs1!Branch_ID: rs1.MoveNext: Wend
If agen.ListCount <> 0 Then agen.ListIndex = 0: cab.ListIndex = 0

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

End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub

Private Sub lap_Click(Index As Integer)
indeks = Index
Select Case Index
Case 0
'Per-agen
agen.Enabled = True: cab.Enabled = False
dt_dari.Enabled = False: dt_sampai.Enabled = False
Case 1
'Per-agen Per-Periode
agen.Enabled = True: cab.Enabled = False
dt_dari.Enabled = True: dt_sampai.Enabled = True
Case 2
'Per-cabang
agen.Enabled = False: cab.Enabled = True
dt_dari.Enabled = False: dt_sampai.Enabled = False
Case 3
'Per-cabang Per-periode
agen.Enabled = False: cab.Enabled = True
dt_dari.Enabled = True: dt_sampai.Enabled = True
Case 4
'Total-seluruh-cabang
agen.Enabled = False: cab.Enabled = False
dt_dari.Enabled = False: dt_sampai.Enabled = False
Case 5
'Total-seluruh Kantor Pusat-PL
agen.Enabled = False: cab.Enabled = False
dt_dari.Enabled = False: dt_sampai.Enabled = False
Case 6
'Total-data Per-periode
agen.Enabled = False: cab.Enabled = False
dt_dari.Enabled = True: dt_sampai.Enabled = True
Case 7
'Total-seluruh-data
agen.Enabled = False: cab.Enabled = False
dt_dari.Enabled = False: dt_sampai.Enabled = False
Case 8
'RPP
agen.Enabled = False: cab.Enabled = True
dt_dari.Enabled = True: dt_sampai.Enabled = True
End Select
End Sub

Private Sub selesai_Click()
Unload Me
End Sub

Seperti biasa pada saat memprogram tentu anda diharapkan hasil keluarannya (print-out),
Visual Basic 6.0 mempunyai bawaan Data Report,

Ada program external yang sering digunakan crystall report, disini saya menggunakan Cr 9, karena ada permintaan user untuk dapat mengconvert data menjadi pdf.