Pada postingan kali ini admin akan melakukan posting tentang pembuatan Sisfo Administrasi Toko, form pertama yang akan dibuat yaitu Form Input Data pemasok. Aplikasi dibuat menggunakan Visual Basic 6 dengan Database Ms.Access.
Untuk Tampilannya sebagai berikut :Listing Code Program sebagai berikut :
Dim dtbs As Database
Dim tbl As Recordset
Dim konterdata
Private Sub cmdbaru_Click()
If cmdbaru.Caption = "&Baru" Then
cmdbaru.Caption = "&Simpan"
cmdrubah.Caption = "&Batal"
Call frmkosong
Call frmaktif
Call cmdtdaktif
cmdbaru.Enabled = True
cmdrubah.Enabled = True
konterdata = "Y"
DBGrid1.Enabled = False
Call buatkode
Text2.SetFocus
Else
Dim caridata As String, kunci As String
If Text2.Text = " " Then
p = MsgBox("Nama pemasok belum diisi...!", vbOKOnly + vbInformation, "Informasi")
Text2.SetFocus
Else
kunci = Text1.Text
caridata = "kdpemasok='" & kunci & "'"
tbl.FindFirst caridata
If tbl.NoMatch Then
tbl.AddNew
Call frmmasuk
tbl.Update
Else
tbl.Edit
Call frmmasuk
tbl.Update
End If
cmdbaru.Caption = "&Baru"
cmdrubah.Caption = "&Rubah"
Call cmdaktif
Call frmtdaktif
konterdata = "T"
DBGrid1.Enabled = True
tbl.MoveLast
Set Data1.Recordset = tbl
DBGrid1.ReBind
End If
End If
End Sub
Private Sub Form_Activate()
Label1.Caption = gnamains
Label2.Caption = galins
Label3.Caption = gtelpins
End Sub
Private Sub Form_Load()
Call tetapkandata
konterdata = "T"
DBGrid1.ReBind
Call cekdata
End Sub
Private Sub cmdrubah_Click()
If cmdrubah.Caption = "&Rubah" Then
cmdrubah.Caption = "&Batal"
cmdbaru.Caption = "&Simpan"
konterdata = "T"
DBGrid1.Enabled = False
Call frmaktif
Call cmdtdaktif
cmdbaru.Enabled = True
cmdrubah.Enabled = True
Text2.SetFocus
Else
cmdrubah.Caption = "&Rubah"
cmdbaru.Caption = "&Baru"
konterdata = "T"
DBGrid1.Enabled = True
Call cekdata
End If
End Sub
Private Sub cmdhapus_Click()
On Error Resume Next
hapus = MsgBox("Yakin akan dihapus ?", vbOKCancel + vbQuestion, "Konfirmasi")
If hapus = vbOK Then
tbl.Delete
tbl.MoveNext
Else
tbl.MoveFirst
End If
Call tetapkandata
DBGrid1.ReBind
On Error GoTo 0
End Sub
Private Sub cmdtutup_Click()
Unload Me
End Sub
Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If konterdata = "T" Then
Call frmtampil
End If
End Sub
Public Sub buatkode()
If tbl.RecordCount > 0 Then
tbl.MoveLast
nourut = Val(Right(tbl("kdpemasok"), 4)) + 1
If nourut < 10 Then
Text1.Text = "PMS000" + LTrim(Str(nourut))
ElseIf nourut < 100 Then
Text1.Text = "PMS00" + LTrim(Str(nourut))
ElseIf nourut < 1000 Then
Text1.Text = "PMS0" + LTrim(Str(nourut))
ElseIf nourut < 10000 Then
Text1.Text = "PMS" + LTrim(Str(nourut))
Else
Text1.Text = "PMS0000"
End If
Else
Text1.Text = "PMS0001"
End If
End Sub
Private Sub Form_Resize()
bg.Width = Me.Width
bg.Height = Me.Height
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text2.Text)) > 50 Then
MsgBox ("Maksimal 50 karakter, coba cek lagi!")
Text2.SetFocus
Else
Text3.SetFocus
End If
End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text3.Text)) > 50 Then
MsgBox ("Maksimal 50 karakter, coba cek lagi!")
Text3.SetFocus
Else
Text4.SetFocus
End If
End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Len(Trim(Text4.Text)) > 15 Then
MsgBox ("Maksimal 15 karakter, coba cek lagi!")
Text4.SetFocus
Else
cmdbaru.SetFocus
End If
End If
End Sub
Private Sub frmkosong()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
End Sub
Public Sub frmaktif()
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
End Sub
Public Sub frmtdaktif()
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
End Sub
Public Sub frmmasuk()
With tbl
!kdpemasok = Trim(Text1.Text)
!nmpemasok = Trim(Text2.Text)
!alpemasok = Trim(Text3.Text)
!telppemasok = Trim(Text4.Text)
On Error GoTo 0
End With
End Sub
Public Sub frmtampil()
If tbl.EOF = False Then
Text1.Text = tbl("kdpemasok")
Text2.Text = tbl("nmpemasok")
Text3.Text = tbl("alpemasok")
Text4.Text = tbl("telppemasok")
Else
Call frmkosong
End If
End Sub
Public Sub cmdaktif()
cmdbaru.Enabled = True
cmdrubah.Enabled = True
cmdhapus.Enabled = True
cmdtutup.Enabled = True
End Sub
Public Sub cmdtdaktif()
cmdbaru.Enabled = False
cmdrubah.Enabled = False
cmdhapus.Enabled = False
cmdtutup.Enabled = False
End Sub
Public Sub cekdata()
If tbl.RecordCount > 0 Then
Call cmdaktif
Call frmtampil
Else
Call cmdtdaktif
cmdbaru.Enabled = True
cmdtutup.Enabled = True
Call frmkosong
End If
Call frmtdaktif
End Sub
Public Sub tetapkandata()
Set dtbs = OpenDatabase(App.Path & "\datatoko.mdb")
Set tbl = dtbs.OpenRecordset("pemasok", dbOpenDynaset)
Set Data1.Recordset = tbl
End Sub
0 Response to "Code Program Input Data Pemasok Sisfo Administrasi Toko"
Posting Komentar