visual basic + sql server + active report

Ketika kita membangun sebuah aplikasi database, kita tentunya menginginkan perpaduan yang ideal antara bahasa pemrograman, database dan reporting tool. Menurut saya… untuk membangun aplikasi khususnya yang berbasis desktop, komposisi yang paling ideal adalah visual basic 6 + sql server + active report.

Dengan perpaduan tersebut, kita dapat membangun berbagai aplikasi client-server beserta reportingnya tanpa membutuhkan banyak komponen tambahan.
Untuk reporting, sebenarnya paling powerfull adalah menggunakan crystal report. Tetapi, terlalu banyak komponen yang diperlukan saat kita akan mengkompilasi dan membuat installer dari aplikasi kita. Mungkin bagi yang sudah mahir, tidak ada kesulitan dalam hal tersebut. Namun bagi pemula seperti saya tentunya akan kebingungan memilih komponen mana saja yang harus disertakan.
Ok… Langsung aja yach… dalam bagian ini saya akan mencoba berbagi dan menunjukkan pengalaman saya untuk membuat hubungan antara ketiganya.

1. Buat satu database di SQL Server 2000 dan jangan lupa untuk membuat sedikitnya satu table. Sebagai contoh database sekolah dan table siswa.


2. Bagaimana? Sudah kan? Selanjutnya kita akan beralih ke VB 6 dan hal pertama yang harus dibuat adalah modul koneksi dengan database.
3. Buka Project baru VB6 dan tambahkan satu modul ke dalamnya kemudian ketikkan kode berikut :

Public koneksi as adodb.connection
Public sub konekdb()
Set koneksi=new ADODB.connection
With koneksi
.CommandTimeout = 300
.CursorLocation = adUseClient
.ConnectionString = strCon
.Open "Provider=SQLOLEDB.1;" & _
"Data Source=(local);" & _
"Initial Catalog=sekolah;" & _
"User ID=sa;" & _
"Password=passwordsauser;" & _
"Persist Security Info=True;" & _
"OLE DB Services = -2;"
End With
If err.Number Then
MsgBox "Gagal menghubungi komputer Inven!" & vbNewLine & err.Description, vbOKOnly + vbCritical
Exit sub
End If
End sub

O ya.. tambahkan juga reference Microsoft ActiveX Data Objects 2.x Library
4. Tambahkan modul satu lagi untuk menampung kode state form dan kodenya :

Public Enum FormState
adStateAddMode = 0
adStateEditMode = 1
adStatePopupMode = 2
End Enum

5. Kalau sudah kita buka form1 dan letakkan beberapa komponen diantaranya
-1 listview
-5 textbox
-6 command button
-1 masked box
dengan default name nya aja dan atur posisinya seperti ini

6. Create satu active report dengan klik kanan pada project1 pilih add--> Data Dynamics ActiveReports2.0 kemudian tambahkan komponen sebagai berikut :


Dan beberapa label seperti pada gambar ini :

7. Kemudian pada form1 ketikkan kode berikut :

Dim WithEvents rs As ADODB.Recordset
Public state As FormState
Private Sub Command1_Click()
kosongfield
releasefield
Text1.SetFocus
SetButtons False
Me.state = adStateAddMode
End Sub

Private Sub Command2_Click()
releasefield
SetButtons False
Me.state = adStateEditMode
End Sub

Private Sub Command3_Click()
Dim strsqldel As String
On Error Resume Next
strsqldel = "delete from tblsiswa where nis='" & ListView1.SelectedItem.Text & "'"
If ListView1.SelectedItem.Text = "" Then
MsgBox "Tidak ada rekord yang akan dihapus", vbInformation, "Informasi"
Else
X = MsgBox("Apakah anda yakin ingin menghapus data secara permanen? ", vbExclamation + vbYesNo, "konfirmasi")
If X = vbYes Then
koneksi.Execute strsqldel
rs.Requery
Call Form_Load
Else
End If
End If
End Sub

Private Sub Command4_Click()
On Error Resume Next
If Me.state = adStateAddMode Then
strkueri = "insert into tblsiswa values('" & Text1.Text & "', " & _
" '" & Text2.Text & "'," & _
" '" & Text3.Text & "'," & _
" '" & Me.MaskEdBox1.Text & "'," & _
" '" & Text5.Text & "')"
pesan = "Data berhasil ditambahkan"
ElseIf Me.state = adStateEditMode Then
strkueri = "update tblsiswa set nis='" & Text1.Text & "'," & _
" nama= '" & Text2.Text & "', " & _
" tempat_lahir='" & Text3.Text & "'," & _
" tanggal_lahir= '" & MaskEdBox1.Text & "'," & _
" agama= '" & Text5.Text & "'where nis='" & ListView1.SelectedItem.Text & "'"
pesan = "Data berhasil diedit"
End If
koneksi.Execute strkueri
MsgBox "" & pesan, vbInformation, "Informasi"
'refreshrekord
SetButtons True
Call Form_Load
End Sub

Private Sub Command5_Click()
Call Form_Load
End Sub

Private Sub Command6_Click()
End
End Sub

Private Sub Command7_Click()
With ActiveReport1.DataControl1
.CursorLocation = koneksi.CursorLocation
.CursorType = ddADOOpenDynamic
.ConnectionString = koneksi.ConnectionString
.Source = "select * from tblsiswa"
End With
ActiveReport1.Show
End Sub

Private Sub Form_Load()
On Error Resume Next
konekdb
Set rs = New ADODB.Recordset
rs.Open "select * from tblsiswa", koneksi
ListView1.ListItems.Clear
If rs.RecordCount <> 0 Then
filltext
isilist
kuncifield
SetButtons True
Else
End If
End Sub
Sub filltext()
Text1.Text = rs!nis
Text2.Text = rs!nama
Text3.Text = rs!tempat_lahir
MaskEdBox1.Mask = ""
Me.MaskEdBox1.Text = rs!tanggal_lahir
Text5.Text = rs!agama
Dim ListVwItem As MSComctlLib.ListItem
Dim Value As String
Dim Value2 As String
Value = rs!nis
For Each ListVwItem In ListView1.ListItems
If Trim(ListVwItem.Text) = Trim(Value) Then 'find complete words
ListVwItem.Selected = True
ListVwItem.EnsureVisible
Exit For
End If
Next
End Sub
Sub isilist()
On Error Resume Next
With rs
For i = 0 To rs.Fields.Count
ListView1.ColumnHeaders.Add i + 1, , rs.Fields(i).Name
Next i
.MoveFirst
Do While Not .EOF
Set LI = ListView1.ListItems.Add(, , Trim(!nis))
LI.SubItems(1) = Trim(!nama)
LI.SubItems(2) = Trim(!tempat_lahir)
LI.SubItems(3) = Trim(!tanggal_lahir)
LI.SubItems(4) = Trim(!agama)
.MoveNext
Loop

End With
End Sub
Sub kosongfield()
On Error Resume Next
Dim txt As Control
'clear the text boxes
For Each txt In Me
If TypeOf txt Is TextBox Then txt.Text = ""
Next
Me.MaskEdBox1.Text = ""
MaskEdBox1.Mask = "##/##/####"
End Sub
Sub kuncifield()
On Error Resume Next
Dim txt As Control
'Locked the text boxes
For Each txt In Me
If TypeOf txt Is TextBox Then txt.Locked = True
Next
Me.MaskEdBox1.Enabled = False
End Sub
Sub releasefield()
On Error Resume Next
Dim txt As Control
'UnLocked the text boxes
For Each txt In Me
If TypeOf txt Is TextBox Then txt.Locked = False
Next
Me.MaskEdBox1.Enabled = True
End Sub
Sub SetButtons(bVal As Boolean)
Command1.Visible = bVal
Command2.Visible = bVal
Command4.Visible = Not bVal
Command5.Visible = Not bVal
Command3.Visible = bVal
Command6.Visible = bVal
Command7.Visible = bVal
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim Item2 As ListItem
Set Item2 = ListView1.ListItems.Item(ListView1.SelectedItem.Index)
rs.MoveFirst
'Text1 = UCase(Trim(Text1))
'msgbox""&
rs.Find (" nis = '" & Me.ListView1.SelectedItem & "'")
If rs.AbsolutePosition > 0 Then
filltext
ElseIf rs.AbsolutePosition <>

8. Yang terakhir ketik kode berikut pada active report

Private Sub PageFooter_BeforePrint()
Me.lblpage.Caption = Me.pageNumber
End Sub

Private Sub ReportHeader_BeforePrint()
lbldate.Caption = "Di cetak tanggal : " & Format(Date, "dd/mm/yyyy")
End Sub