22.12
Unknown
Assalamualaikum …!!
Sebelum nya terimakasi gan,udh mw berkunjung di blog ini,
Ok langsung ajj ya,.kali ini saya akan berbagi cara bagaimana zie membuat form input di Misual Basic 6.0..? Yuuk,langsung aja
Ok kali ini saya akan mencoba membuat form input sederhana,kali ini saya akan membuat form input DATA BANTUAN BRR,.hahah Asyik,kebetulan akhir2 ini kan bnyak bantuan,terutama Perumahan ,
Ok e.emg zie gk lengkap2 banget,.,ok langsung ajj la,dari tadi Asyik ngomong aja..sorry ya guys..
Pertama Buka Visual Basic nya
Cara nya klik Pada Icon Microsoft Visual Basic 6.0 Pada Sourhcut Laptop anda => Pilih Standar EXE =>Makan akan tampil lember kerja nya seperti ini
Seteleh itu rancang bentuk Form nya kira2 seperti ini :
Adapun komponen Toolbox yang di Pakai
9 buah Label,5 bhTexbook,Comman Button 4,Data Grid 1,Adodc 2 bh, 2 bh Timer
Ok silakan Desain Sendiri
Kali ini saya akan memberikan foto BESAR nya
Ok kan guys ,.setelah di desain seperti ini :
Kemudian Masukkan Sintak nya berikut ini :
Private Sub Command1_Click()
On Error Resume Next
If Command1.Caption = "Input" Then
Adodc1.Recordset.AddNew
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Text1.SetFocus
Command1.Caption = "Simpan"
Command4.Caption = "Batal"
ElseIf Command1.Caption = "Simpan" Then
On Error Resume Next
Adodc1.Recordset.Update
Adodc1.Recordset.MoveNext
Adodc1.Recordset.MovePrevious
Text5.Text = DataGrid1.ApproxCount
Command1.Caption = "Input"
Command4.Caption = "Tutup"
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Command1.Caption = "Simpan"
Command4.Caption = "Batal"
End Sub
Private Sub Command3_Click()
On Error Resume Next
Dim Hapus
Hapus = MsgBox("Anda Yakin Data Ini Akan Dihapus???", vbQuestion + vbYesNo, "Hapus Data")
If Hapus = vbYes Then
Adodc1.Recordset.Delete adAffectCurrent
Adodc1.Refresh
Adodc1.Recordset.Update
Adodc1.Refresh
Else
MsgBox "Data Tidak Jadi Dihapus!!!", vbOKOnly + vbInformation, "Batal Menghapus"
End If
Text5.Text = DataGrid1.ApproxCount
End Sub
Private Sub Command4_Click()
On Error Resume Next
If Command4.Caption = "Tutup" Then
'---------------------------------
'rumus untuk form pindah ke kanan
Do
Me.Left = Me.Left + 5
Me.Move Me.Left, Me.Top
DoEvents
Loop Until Me.Left > Screen.Width
Unload Me
'--------
Form6.Show
ElseIf Command4.Caption = "Batal" Then
Command1.Caption = "Input": Command4.Caption = "Tutup"
On Error Resume Next
Adodc1.Refresh
Adodc1.Recordset.MovePrevious: Adodc1.Recordset.MoveNext
'Adodc2.Recordset.MovePrevious: Adodc2.Recordset.MoveNext
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
End If
End Sub
Private Sub Form_Activate()
On Error Resume Next
Adodc1.Refresh
DataGrid1.Refresh
DataReport.Refresh
Text5.Text = DataGrid1.ApproxCount
End Sub
Private Sub Form_Load()
'----------------------
'rumus untuk tanggal,waktu,dan hari
Label9 = Time
Label10 = Date
'-------------
On Error Resume Next
Dim lokasi As String
With Form1.Adodc1
On Error Resume Next
If Right(App.Path, 1) = "\" Then
lokasi = Left(App.Path, Len(App.Path) - 1)
Else
lokasi = App.Path
End If
.ConnectionString = "provider=microsoft.jet.oledb.4.0;Data source=" & lokasi & "\db_brr.mdb;persist security info=false"
.RecordSource = "select*from tbl_brr"
Text1.DataField = "kode_bantuan"
Text2.DataField = "nama_penerima"
Text3.DataField = "alamat"
Text4.DataField = "jumlah_dana"
End With
Text5.Text = DataGrid1.ApproxCount
'---------------------------------
'-------------------------
With Form1.Adodc2
.ConnectionString = "provider=microsoft.jet.OLEDB.4.0;Data source=" & lokasi & "\db_brr.mdb;persist security info=false"
End With
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim x As Integer
If Not KeyAscii = 13 Then
Exit Sub
End If
With Form1.Adodc2
.RecordSource = "select*from tbl_brr where kode_bantuan='" & Text1.Text & "'"
.Refresh
End With
With Form1.Adodc2.Recordset
If .RecordCount = 0 Then
Text2.SetFocus
Exit Sub
End If
x = MsgBox("kode_bantuan:" + Text1.Text + ",Telah Terdaftar Atas Nama:" + !nama_penerima, vbOKOnly, "perhatian!")
Text1.Text = "": Text1.SetFocus
End With
End Sub
Private Sub Text2_Change()
Adodc1.Caption = Text2.Text
End Sub
Private Sub Timer1_Timer()
'rumus tulisan bergerak
Label1.Visible = Not Label1.Visible
End Sub
Private Sub Timer2_Timer()
'rumus tulisan bergerak
Label6.Visible = Not Label6.Visible
End Sub
Ok selesai dech Ya guys,nanti kalo masi ada yang kurang silakan kritik aja guys,.kami siap mnerima saran siapa pun.wowkwkwkkw…..
Terimong Geunase ……..
Posted in: Tutorial Visual Basic
0 komentar:
Posting Komentar