Hay,... teman teman setanah air mahasiswa semester 4C yang lagi gagagaallaaaauuu banget dengan Visual Basiccc akhir - akhir ini ...
bahkan sempattt kecewa berat gara-gara Vb karena dengan semua action nya banya yang ""DEBUUGG""
sangat mengasiiikkkann sekaliii.. penuh tantangan itu,,, hahahahaha
nahh ni aku mau share listing programkkuuu biar gag galau lagiii,,, n ga ketemu ma DEEEBUUGG
tapi ... untuk source kodenyaa nichh ada yang perlu diganti yaaaa,,,,
menyesuaikann punya sobat-sobat.....
okkkeee !! thuannkksss
Dim DBLATIHAN As Database
Dim TBPENCATATAN As Recordset
Dim tbpasien As Recordset
Dim x As Integer
Sub otomatis()
Dim no As Integer
With adodcpencatatan.Recordset
adodcpencatatan.RecordSource = "no_reg from TBPENCATATAN"
If .RecordCount <= 0 Then
Label2.Caption = "P0001"
Else
.MoveLast
no = Val(Right(adodcpencatatan.Recordset!no_reg, 4)) + 1
Label2.Caption = Format(no, "P0000")
End If
End With
End Sub
Private Sub siap()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
Text6.Enabled = True
Text7.Enabled = True
Combo1.AddItem ""
DataGrid2.Visible = True
Text2.SetFocus
End Sub
Private Sub tdksiap()
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.Enabled = False
Text6.Enabled = False
Text7.Enabled = False
DataGrid2.Visible = True
End Sub
Private Sub kosong()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
otomatis
End Sub
Private Sub Combo1_CLICK()
Dim A As Currency
Text7.Text = A
If Combo1.Text = " Injeksi " Then
A = 50000
Else
If Combo1.Text = " Pengobatan Luka " Then
A = 30000
Else
A = 20000
End If
End If
Text7.Text = "" & Format(A, "currency")
End Sub
Private Sub Command1_Click()
Dim panjang As Integer
panjang = Len(Text1.Text)
If panjang < 6 Then
Exit Sub
End If
tbpasien.Seek "=", Text1.Text
If tbpasien.NoMatch Then
MsgBox "No_RM Tidak Ada, Ganti Yang Lain !", 0 + 16, "Peringatan"
Text2.SetFocus
Else
Text2.Text = tbpasien!Nama
Text3.Text = tbpasien!alamat
Text4.Text = tbpasien!j_kel
Text5.Text = tbpasien!Status
Text6.Text = tbpasien!pendidikan
End If
End Sub
Private Sub Form_Load()
Combo1.AddItem " Injeksi "
Combo1.AddItem " Pengobatan Luka "
Combo1.AddItem " Jahit Luka "
Set DBLATIHAN = OpenDatabase("D:\Endahdrs4c\DBLATIHAN.mdb")
Set TBPENCATATAN = DBLATIHAN.OpenRecordset("TBPENCATATAN")
TBPENCATATAN.Index = "xno_reg"
Set tbpasien = DBLATIHAN.OpenRecordset("TBPASIEN")
tbpasien.Index = "xno_rm"
Label4.Caption = Format(DateTime.Now, "dd/ MM/ yyyy" & vbCrLf & "hh : mm : ss")
End Sub
Private Sub Text1_Change()
Dim panjang As Integer
panjang = Len(Text1.Text)
If panjang < 6 Then
Exit Sub
End If
If x = 1 Then
TBPENCATATAN.Seek "=", Text1.Text
Else
If TBPENCATATAN.NoMatch Then
End If
End If
End Sub
Private Sub cmdSimpan_Click()
If x = 1 Then
adodcpencatatan.Recordset.AddNew
Else
x = 2
End If
adodcpencatatan.Recordset!no_rm = Text1.Text
adodcpencatatan.Recordset!no_reg = Label2.Caption
adodcpencatatan.Recordset!Tgl_daftar = Label4.Caption
adodcpencatatan.Recordset!Tindakan = Combo1.Text
adodcpencatatan.Recordset!biaya = Text7.Text
DataGrid1.Refresh
tdksiap
x = 0
Cmdselesai.Enabled = True
Cmdedit.Enabled = True
Cmdhapus.Enabled = True
Cmdtambah.Enabled = True
DataGrid2.Visible = False
End Sub
Private Sub cmdEdit_Click()
adodcpencatatan.Recordset!no_rm = Text1.Text
adodcpencatatan.Recordset!no_reg = Label2.Caption
adodcpencatatan.Recordset!Tgl_daftar = Label4.Caption
adodcpencatatan.Recordset!Tindakan = Combo1.Text
adodcpencatatan.Recordset!biaya = Text7.Text
adodcpencatatan.Recordset.Update
DataGrid1.Refresh
Cmdtambah.Enabled = False
Cmdsimpan.Enabled = True
Cmdbatal.Enabled = True
Cmdedit.Enabled = False
Cmdhapus.Enabled = False
Cmdselesai.Enabled = False
siap
Text1.SetFocus
DataGrid2.Visible = False
x = 2
End Sub
Private Sub cmdBatal_Click()
kosong
Cmdtambah.Enabled = True
Cmdsimpan.Enabled = False
Cmdbatal.Enabled = False
Cmdedit.Enabled = True
Cmdhapus.Enabled = True
Cmdselesai.Enabled = True
tdksiap
DataGrid2.Visible = False
End Sub
Private Sub cmdHapus_Click()
Dim jwb As Integer
jwb = MsgBox("Yakin Hapus Data ?", 4 + 32, "Konfirmasi")
If jwb = 6 Then
adodcpencatatan.Recordset.Delete
DataGrid1.Refresh
'otomatis
Text1.Text = ""
kosong
Else
Exit Sub
End If
DataGrid2.Visible = False
End Sub
Private Sub cmdSelesai_Click()
Unload Me
FRM18MENUUTAMA.Show
End Sub
Private Sub cmdTambah_Click()
'Manipulasi Tombol
'-------------------------------
Cmdtambah.Enabled = False
Cmdsimpan.Enabled = True
Cmdbatal.Enabled = True
Cmdedit.Enabled = False
Cmdhapus.Enabled = False
Cmdselesai.Enabled = True
'--------------------------------
x = 1
siap
kosong
otomatis
Text1.SetFocus
DataGrid2.Visible = False
End Sub
Private Sub Form_Activate()
'Manipulasi Tombol
'-------------------------------
Cmdtambah.Enabled = True
Cmdsimpan.Enabled = False
Cmdbatal.Enabled = False
Cmdedit.Enabled = True
Cmdhapus.Enabled = True
Cmdselesai.Enabled = True
'--------------------------------
End Sub
Private Sub DataGrid1_Click()
'kode perintah untuk menampilkan data yang sudah disimpan di dalam grid ke textbox
Text1.Text = adodcpencatatan.Recordset!no_rm
Label2.Caption = adodcpencatatan.Recordset!no_reg
Label4.Caption = adodcpencatatan.Recordset!Tgl_daftar
Text2.Text = Adodcpasien.Recordset!Nama
Text3.Text = Adodcpasien.Recordset!alamat
If Adodcpasien.Recordset!j_kel = 1 Then
Text4.Text = "Pria"
Else
Text4.Text = "Wanita"
End If
If Adodcpasien.Recordset!Status = 1 Then
Text5.Text = " Menikah "
Else
If Adodpasien.Recordset!Status = 2 Then
Text5.Text = " Belum / Tidak Menikah "
Else
Text5.Text = " Duda / Janda "
End If
End If
If Adodcpasien.Recordset!pendidikan = "1" Then
Text6.Text = " Belum/Tidak Sekolah "
Else
If Adodcpasien.Recordset!pendidikan = "2" Then
Text6.Text = "SD"
Else
If Adodcpasien.Recordset!pendidikan = "3" Then
Text6.Text = "SMP"
Else
If Adodcpasien.Recordset!pendidikan = "4" Then
Text6.Text = "SMA"
Else
If Adodcpasien.Recordset!pendidikan = "5" Then
Text6.Text = "PT"
End If
End If
End If
End If
End If
Combo1.Text = adodcpencatatan.Recordset!Tindakan
Text7.Text = adodcpencatatan.Recordset!biaya
End Sub
wuaaa... apaan ituu.. :O
BalasHapus