Nahh , dibawah ini adalah tampilan form beserta Coding yang telah selesai.
Di bawah ini adalah Source Codingnya :
Private Sub nomor()
Dim no As String
With DataBarang
If .Recordset.RecordCount <> 0 Then
.Recordset.MoveLast
no = Val(Right(.Recordset!kdbarang, 4)) + 1
If Len(Trim(no)) = 1 Then
txtinduk.Text = "B" + "000" + no
End If
If Len(Trim(no)) = 2 Then
txtkinduk.Text = "B" + "00" + no
End If
If Len(Trim(no)) = 3 Then
txtinduk.Text = "B" + "0" + no
End If
If Len(Trim(no)) = 4 Then
txtinduk.Text = "B" + no
End If
Else
txtinduk.Text = "B0001"
End If
End With
End Sub
Sub isilist()
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
Dim ch As ColumnHeader, lv As ListItem
ListView1.View = lvwReport
Set ch = ListView1.ColumnHeaders.Add(, , "No Induk", 1000)
Set ch = ListView1.ColumnHeaders.Add(, , "ID", 1000)
Set ch = ListView1.ColumnHeaders.Add(, , "Kelas Terapi", 9500)
Set ch = ListView1.ColumnHeaders.Add(, , "Halaman", 1000)
ListView1.GridLines = True
ListView1.Enabled = True
OpenRecordset "Select * from terapi_1;"
If Not Rs.EOF Then
Do Until Rs.EOF
Set lv = ListView1.ListItems.Add(, , Rs.Fields!induk)
lv.SubItems(1) = Rs.Fields!id
lv.SubItems(2) = Rs.Fields!kls_terapi
lv.SubItems(3) = Rs.Fields!hal
Rs.MoveNext
Loop
End If
End Sub
Sub kosong()
txtinduk.Text = ""
txtid.Text = ""
txtterapi.Text = ""
txthalaman.Text = ""
txtinduk.BackColor = vbWhite
End Sub
Private Sub cmdadd_Click()
cmdbatal.Visible = True
cmdadd.Enabled = False
cmdsave.Enabled = True
cmddalate.Enabled = True
cmdedit.Enabled = True
cmdprint.Enabled = True
txtinduk.Enabled = True
txtid.Enabled = True
txtterapi.Enabled = True
txthalaman.Enabled = True
txtinduk.SetFocus
txtinduk.BackColor = &H80000000
ListView1.Enabled = True
End Sub
Sub TampilData()
If txtCari.Text = "" Then
Rs.Open "SELECT * FROM terapi_1 ORDER BY induk ASC", Cn, adOpenKeyset, adLockPessimistic
Exit Sub
End If
OpenRecordset " SELECT * from terapi_1 " & _
" where induk like '" & txtCari.Text & "'"
txtCari.SetFocus
If Rs.RecordCount > 0 Then
ListView1.ListItems.Clear
Do While Not Rs.EOF
Set lv = ListView1.ListItems.Add(, , Rs.Fields!induk)
With lv
lv.SubItems(1) = Rs.Fields!id
lv.SubItems(2) = Rs.Fields!kls_terapi
lv.SubItems(3) = Rs.Fields!hal
End With
Rs.MoveNext
Loop
End If
Rs.Close
Set Rs = Nothing
End Sub
Private Sub cmdbatal_Click()
cmdadd.Visible = True
cmdbatal.Visible = False
cmdadd.Enabled = True
ListView1.Enabled = False
cmdsave.Enabled = False
cmddalate.Enabled = False
cmdedit.Enabled = False
cmdprint.Enabled = False
txtinduk.Enabled = False
txtid.Enabled = False
txtterapi.Enabled = False
txthalaman.Enabled = False
txtinduk.BackColor = vbWhite
kosong
End Sub
Private Sub cmdcari_Click()
If txtCari.Text = "" Then
MsgBox " Data Tidak Ditemukan", , "Info"
Exit Sub
End If
If Trim(txtCari.Text) <> "" Then
TampilData
Else
ListView1.ListItems.Clear
End If
End Sub
Private Sub cmddalate_Click()
If txtinduk.Text = "" And txtid.Text = "" And txtterapi.Text = "" And txthalaman.Text = "" Then
MsgBox "silakan cari data yang ingin di hapus", vbCritical
Else
MsgBox "Data Berhasil Di Hapus..", vbInformation, "Insert Data"
eksekusiSQL "Delete from terapi_1 " & _
" where id = '" & txtid.Text & "';"
kosong
isilist
txtid.SetFocus
End If
End Sub
Private Sub cmdedit_Click()
If txtinduk.Text = "" And txtid.Text = "" And txtterapi.Text = "" And txthalaman.Text = "" Then
MsgBox "silakan cari data yang ingin di edit", vbCritical
Else
MsgBox "Data Berhasil Di Edit..", vbInformation
eksekusiSQL "Update terapi_1" & _
" set induk = '" & txtinduk.Text & "', " & _
" kls_terapi = '" & txtterapi.Text & "'," & _
" hal = '" & txthalaman.Text & "'" & _
" where id = '" & txtid.Text & "';"
kosong
isilist
txtinduk.SetFocus
End If
End Sub
Private Sub cmdprint_Click()
With Crpt1
.ReportFileName = "F:\Serba VB\ASKES\Laporan_Terapi.rpt"
.Destination = crptToWindow
.WindowState = crptMaximized
.RetrieveDataFiles
.Action = 1
End With
End Sub
Private Sub cmdsave_Click()
OpenRecordset "SELECT induk, id, kls_terapi, hal from terapi_1 " & _
" where id = '" & txtid.Text & "'"
If Not Rs.EOF Then
txtid = Rs.Fields!id
MsgBox "Kode Sudah Ada Dalam Database !!..", vbInformation, "Perhatian"
txtid = ""
Else
If txtinduk.Text = "" And txtid.Text = "" And txtterapi.Text = "" And txthalaman.Text = "" Then
MsgBox "silakan isi data dulu", vbCritical
ElseIf txtinduk.Text = "" Then
MsgBox "Ada Data Yang Belum Di isi", vbCritical
ElseIf txtid.Text = "" Then
MsgBox "Ada Data Yang Belum Di isi", vbCritical
ElseIf txtterapi.Text = "" Then
MsgBox "Ada Data Yang Belum Di isi", vbCritical
ElseIf txthalaman.Text = "" Then
MsgBox "Ada Data Yang Belum Di isi", vbCritical
Else
MsgBox "Data Sudah Tersimpan"
eksekusiSQL "INSERT INTO terapi_1 values ('" & _
txtinduk.Text & "', " & _
"'" & txtid.Text & "', " & _
"'" & txtterapi.Text & "', " & _
"'" & txthalaman.Text & "');"
kosong
isilist
txtinduk.SetFocus
End If
End If
End Sub
Private Sub Form_Load()
buka 'module
TampilData
isilist
cmdbatal.Visible = False
ListView1.Enabled = False
cmdsave.Enabled = False
cmddalate.Enabled = False
cmdedit.Enabled = False
cmdprint.Enabled = False
txtinduk.Enabled = False
txtid.Enabled = False
txtterapi.Enabled = False
txthalaman.Enabled = False
End Sub
Private Sub isButton1_Click()
If txtCari.Text = "" Then
MsgBox " Data Tidak Ditemukan", , "Info"
Exit Sub
End If
If Trim(txtCari.Text) <> "" Then
TampilData
Else
ListView1.ListItems.Clear
End If
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtinduk.Text = ListView1.SelectedItem
txtid.Text = ListView1.SelectedItem.SubItems(1)
txtterapi.Text = ListView1.SelectedItem.SubItems(2)
txthalaman.Text = ListView1.SelectedItem.SubItems(3)
End Sub
Private Sub Timer1_Timer()
lbltime.Caption = Time
lbltanggal.Caption = Date
End Sub
Private Sub txthalaman_Click()
txthalaman.BackColor = &H80000000
txtid.BackColor = vbWhite
txtterapi.BackColor = vbWhite
txtinduk.BackColor = vbWhite
End Sub
Private Sub txtid_Click()
txtid.BackColor = &H80000000
txtinduk.BackColor = vbWhite
txtterapi.BackColor = vbWhite
txthalaman.BackColor = vbWhite
End Sub
Private Sub txtinduk_Change()
txtinduk.BackColor = &H80000000
txtid.BackColor = vbWhite
txtterapi.BackColor = vbWhite
txthalaman.BackColor = vbWhite
End Sub
Private Sub txtterapi_Click()
txtterapi.BackColor = &H80000000
txtid.BackColor = vbWhite
txtinduk.BackColor = vbWhite
txthalaman.BackColor = vbWhite
End Sub
Tidak ada komentar:
Posting Komentar