Delphi 7 ( Toko Komputer XYZ )

Coding/Listing :



public
    { Public declarations }
    procedure aktif;
    procedure nonaktif;
    procedure bersih;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.aktif;
begin
lbtanggal.Enabled:= true;
lbjam.Enabled:= true;
ckode.Enabled:= true;
ljenis.Enabled:= true;
eharga.Enabled:= true;
ejumbel.Enabled:= true;
esubtotal.Enabled:= true;
eppn.Enabled:= true;
etobay.Enabled:= true;
ebayar.Enabled:= true;
ekembali.Enabled:= true;
end;

procedure TForm1.nonaktif;
begin
lbtanggal.Enabled:= false;
lbjam.Enabled:= false;
ckode.Enabled:= false;
ljenis.Enabled:= false;
eharga.Enabled:= false;
ejumbel.Enabled:= false;
esubtotal.Enabled:= false;
eppn.Enabled:= false;
etobay.Enabled:= false;
ebayar.Enabled:= false;
ekembali.Enabled:= false;
end;

procedure TForm1.bersih;
begin
ckode.Text:='--Silakan Pilih--';
ljenis.Clear;
eharga.Text:= '0';
ejumbel.Text:= '0';
esubtotal.Text:= '0';
eppn.Text:= '0';
etobay.Text:= '0';
ebayar.Text:= '0';
ekembali.Text:= '0';
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
nonaktif;
bersih;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
lbtanggal.Caption:= datetostr(now);
lbjam.Caption:= timetostr(now);
end;

procedure TForm1.binputClick(Sender: TObject);
begin
aktif;
bersih;
end;

procedure TForm1.ckodeClick(Sender: TObject);
begin
if ckode.ItemIndex = 0 then
begin
ljenis.Clear;
ljenis.Items.Add('Flash Disk 4GB');
ljenis.Items.Add('Flash Disk 8GB');
end
else if ckode.ItemIndex = 1 then
begin
ljenis.Clear;
ljenis.Items.Add('Hardisk 200GB');
ljenis.Items.Add('Hardisk 250GB');
end
else
begin
ljenis.Clear;
ljenis.Items.Add('Keyboard Joystick');
ljenis.Items.Add('Keyboard Logitech');
end;
eharga.Text:= '0';
end;

procedure TForm1.ljenisClick(Sender: TObject);
begin
if ckode.ItemIndex = 0 then
begin
if ljenis.ItemIndex = 0 then
eharga.Text:= '80000'
else
eharga.Text:= '125000';
end
else if ckode.ItemIndex = 1 then
begin
if ljenis.ItemIndex = 0 then
eharga.Text:= '300000'
else
eharga.Text:= '400000';
end
else
begin
if ljenis.ItemIndex = 0 then
eharga.Text:= '75000'
else
eharga.Text:= '100000';
end;
ejumbel.SetFocus;
end;

procedure TForm1.bhitungClick(Sender: TObject);
begin
esubtotal.Text:= inttostr(strtoint(eharga.Text)*strtoint(ejumbel.Text));
eppn.Text:= floattostr(0.1*strtofloat(esubtotal.Text));
etobay.Text:= inttostr(strtoint(esubtotal.Text)+strtoint(eppn.Text));
ebayar.SetFocus;
end;

procedure TForm1.ebayarKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
ekembali.Text:= inttostr(strtoint(ebayar.Text) - strtoint(etobay.Text));
nonaktif;
end;
end;

procedure TForm1.bexitClick(Sender: TObject);
begin
if(application.MessageBox('Yakin Ingin Keluar Dari Program Ini..?!','Question',4+32)=6)then
close
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ckode.Items.Add('001');
ckode.Items.Add('002');
ckode.Items.Add('003');
end;

end.

Read More

Delphi 7 ( Toko Komputer ABC )

Coding/Listing :



public
    { Public declarations }
    procedure aktif;
    procedure nonaktif;
    procedure bersih;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.aktif;
begin
cbmerk.Enabled := true;
cbtipe.Enabled := true;
eharga.Enabled := true;
rbdistributor.Enabled := true;
rbinternasional.Enabled := true;
egaransi.Enabled := true;
chwin7.Enabled := true;
eos.Enabled := true;
ejumbel.Enabled := true;
esubtotal.Enabled := true;
epotongan.Enabled := true;
etotal.Enabled := true;
ebayar.Enabled := true;
ekembali.Enabled := true;
end;

procedure TForm1.nonaktif;
begin
cbmerk.Enabled := false;
cbtipe.Enabled := false;
eharga.Enabled := false;
rbdistributor.Enabled := false;
rbinternasional.Enabled := false;
egaransi.Enabled := false;
chwin7.Enabled := false;
eos.Enabled := false;
ejumbel.Enabled := false;
esubtotal.Enabled := false;
epotongan.Enabled := false;
etotal.Enabled := false;
ebayar.Enabled := false;
ekembali.Enabled := false;
end;

procedure TForm1.bersih;
begin
cbmerk.Text := '--Silakan Pilih--';
cbtipe.Text := '--Silakan pilih--';
eharga.Text := '0';
rbdistributor.Checked := false;
rbinternasional.Checked := false;
egaransi.Text := '0';
chwin7.Checked := false;
eos.Text := '0';
ejumbel.Text := '0';
esubtotal.Text := '0';
epotongan.Text := '0';
etotal.Text := '0';
ebayar.Text := '0';
ekembali.Text := '0';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
cbmerk.Items.Add('ACER');
cbmerk.Items.Add('DELL');
cbmerk.Items.Add('TOSHIBA');
end;

procedure TForm1.cbmerkClick(Sender: TObject);
begin
if cbmerk.Text = 'ACER' then
begin
cbtipe.Text := '--Silakan Pilih--';
cbtipe.Items.Add('AC11R');
cbtipe.Items.Add('AC12R');
end
else if cbmerk.Text = 'DELL' then
begin
cbtipe.Text := '--Silakan Pilih--';
cbtipe.Items.Add('DE13L');
cbtipe.Items.Add('DE14L');
end
else if cbmerk.Text = 'TOSHIBA' then
begin
cbtipe.Text := '--Silakan Pilih--';
cbtipe.Items.Add('TO15A');
cbtipe.Items.Add('TO16A');
end
end;

procedure TForm1.cbtipeClick(Sender: TObject);
begin
if cbtipe.Text = 'AC11R' then
eharga.Text := '1100000'
else if cbtipe.Text = 'AC12R' then
eharga.Text := '1200000'
else if cbtipe.Text = 'DE13L' then
eharga.Text := '1300000'
else if cbtipe.Text = 'DE13L' then
eharga.Text := '1400000'
else if cbtipe.Text = 'TO15A' then
eharga.Text := '1500000'
else
eharga.Text := '1600000'
end;

procedure TForm1.rbdistributorClick(Sender: TObject);
begin
if rbdistributor.Checked = true then
egaransi.Text := '200000'
else
egaransi.Text := '0';
end;

procedure TForm1.rbinternasionalClick(Sender: TObject);
begin
if rbinternasional.Checked = true then
egaransi.Text := '400000'
else
egaransi.Text := '0';
end;

procedure TForm1.ejumbelKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
esubtotal.Text := floattostr((strtofloat(eharga.Text)*strtofloat(ejumbel.Text))+strtofloat(egaransi.Text)+strtofloat(eos.Text));
if strtofloat(ejumbel.Text)>= 5 then
epotongan.Text := floattostr(0.5*strtofloat(esubtotal.Text))
else if strtofloat(ejumbel.Text)>= 2 then
epotongan.Text:= floattostr(0.1*strtofloat(esubtotal.Text))
else
epotongan.Text:=floattostr(0);
etotal.Text := floattostr(strtofloat(esubtotal.Text)-strtofloat(epotongan.Text));
end;

procedure TForm1.ebayarKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
ekembali.Text := floattostr(strtofloat(ebayar.Text)-strtofloat(etotal.Text));
nonaktif;
end
end;

procedure TForm1.bbersihClick(Sender: TObject);
begin
bersih;
aktif;
end;

procedure TForm1.chwin7Click(Sender: TObject);
begin
if chwin7.Checked = true then
eos.Text := '600000'
else
eos.Text := '0';
ejumbel.SetFocus;
end;

procedure TForm1.bkeluarClick(Sender: TObject);
begin
if(application.MessageBox('Yakin Ingin Keluar Dari Program Ini...?!','Question', 4+32)=6)then
close
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
nonaktif;
bersih;
end;

end.

Read More

Visual Basic ( Form SPP ( Lanjutan Form Siswa ) )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0 (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)
3. Microsoft Windows Common Controls-2 6.0 (SP6)

Listing Modul :

Public conn As New ADODB.Connection

Public rssiswa As New ADODB.Recordset

Public rspembayaran As New ADODB.Recordset

Public Sub openDB()

Set conn = New ADODB.Connection

Set rssiswa = New ADODB.Recordset

Set rspembayaran = New ADODB.Recordset

conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\Sekolah.mdb"

End Sub

Listing/Coding :

Sub tampildata()

With rspembayaran

If Not .EOF Then

txtnofak.Text = !no_faktur

txtnis.Text = !nis

txtnama.Text = !nama

txtalamat.Text = !alamat

txtkelas.Text = !kelas

txtjurusan.Text = !jurusan

txtkeahlian.Text = !keahlian

txtspp.Text = !spp

txtpraktek.Text = !praktek

txtosis.Text = !osis

txtujian.Text = !ujian

txtadministrasi.Text = !administrasi

txtbeasiswa.Text = !beasiswa

txttotal.Text = !total

End If

End With

End Sub

Sub auto()

Dim no As String

Dim noint As Integer

With rspembayaran

If .RecordCount = 0 Then

no = "0001"

Else

.MoveLast

noint = Val(Right(!no_faktur, 4)) + 1

no = Right("0000" & noint, 4)

End If

End With

txtnofak.Text = no

End Sub

Sub aktif()

txtnofak.Enabled = True

txtnis.Enabled = True

txtnama.Enabled = True

txtalamat.Enabled = True

txtkelas.Enabled = True

txtjurusan.Enabled = True

txtkeahlian.Enabled = True

txtspp.Enabled = True

txtpraktek.Enabled = True

txtosis.Enabled = True

txtujian.Enabled = True

txtadministrasi.Enabled = True

txtbeasiswa.Enabled = True

txttotal.Enabled = True

txtbayar.Enabled = True

txtkembali.Enabled = True

End Sub

Sub nonaktif()

txtnofak.Enabled = False

txtnis.Enabled = False

txtnama.Enabled = False

txtalamat.Enabled = False

txtkelas.Enabled = False

txtjurusan.Enabled = False

txtkeahlian.Enabled = False

txtspp.Enabled = False

txtpraktek.Enabled = False

txtosis.Enabled = False

txtujian.Enabled = False

txtadministrasi.Enabled = False

txtbeasiswa.Enabled = False

txttotal.Enabled = False

txtbayar.Enabled = False

txtkembali.Enabled = False

End Sub

Sub bersih()

txtnofak.Text = ""

txtnis.Text = ""

txtnama.Text = ""

txtalamat.Text = ""

txtkelas.Text = ""

txtjurusan.Text = ""

txtkeahlian.Text = ""

txtspp.Text = ""

txtpraktek.Text = ""

txtosis.Text = ""

txtujian.Text = ""

txtadministrasi.Text = ""

txtbeasiswa.Text = ""

txttotal.Text = ""

txtbayar.Text = ""

txtkembali.Text = ""

End Sub

Sub tampil()

With rssiswa

If Not .EOF Then

txtnis.Text = !nis

txtnama.Text = !nama

txtalamat.Text = !alamat

txtkelas.Text = !kelas

txtjurusan.Text = !jurusan

txtkeahlian.Text = !keahlian

End If

End With

End Sub

Private Sub Form_Load()

Call openDB

conn.CursorLocation = adUseClient

rspembayaran.Open "Select * from Pembayaran", conn

Set gridpembayaran.DataSource = rspembayaran.DataSource

End Sub

Private Sub Form_Activate()

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = False

cmddelete.Enabled = False

cmdexit.Enabled = True

cmdinput.Enabled = True

cmdinput.SetFocus

End Sub

Private Sub Timer1_Timer()

txttanggal.Text = Format(Date, "dd-mm-yyyy")

txttanggal.Enabled = False

End Sub

Private Sub cmdinput_Click()

aktif

bersih

auto

txtnofak.Enabled = False

txtnis.SetFocus

cmdinput.Enabled = False

cmdsave.Enabled = True

cmdcancel.Enabled = True

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdsave_Click()

Dim sqlsave As String

sqlsave = "insert into Pembayaran values('" & txtnofak & "','" & txttanggal & "','" & txtnis & "','" & txtnama & "','" & txtalamat & "','" & txtkelas & "','" & txtjurusan & "','" & txtkeahlian & "','" & txtspp & "','" & txtpraktek & "','" & txtosis & "','" & txtujian & "','" & txtadministrasi & "','" & txtbeasiswa & "','" & txttotal & "')"

conn.Execute sqlsave

MsgBox "Data Telah Tersimpan"

Form_Load

nonaktif

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = True

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdcancel_Click()

p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

nonaktif

bersih

End If

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = False

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmddelete_Click()

Call openDB

rspembayaran.Open "delete from Pembayara where no_faktur = '" & txtnofak & "'", conn

MsgBox "Data Telah Terhapus"

Form_Load

bersih

nonaktif

cmdinput.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = False

cmdexit.Enabled = True

cmdsave.Enabled = False

End Sub

Private Sub cmdexit_Click()

p = MsgBox("Yakin Ingin Keluar Dari Program Ini....?!?", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

End

End If

End Sub

Private Sub txtnis_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call openDB

rssiswa.Open "select * from Siswa where nis = '" & txtnis & "'", conn

If rssiswa.EOF Then

MsgBox "NIS Yang Anda Masukan Tidak Ada"

txtnis.Text = ""

txtnis.SetFocus

Else

tampil

txtkeahlian.SetFocus

End If

End If

End Sub

Private Sub txtkeahlian_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If txtkeahlian.Text = "Mekanik Otomotif" Then

txtspp.Text = "160000"

txtpraktek.Text = "220000"

txtosis.Text = "25000"

txtujian.Text = "80000"

txtadministrasi.Text = "5000"

ElseIf txtkeahlian.Text = "Programing" Then

txtspp.Text = "140000"

txtpraktek.Text = "400000"

txtosis.Text = "25000"

txtujian.Text = "80000"

txtadministrasi.Text = "5000"

Else

txtspp.Text = "150000"

txtpraktek.Text = "300000"

txtosis.Text = "25000"

txtujian.Text = "80000"

txtadministrasi.Text = "5000"

End If

End If

txtbeasiswa.SetFocus

End Sub

Private Sub txtbeasiswa_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

txttotal.Text = (Val(txtspp.Text) + Val(txtpraktek.Text) + Val(txtosis.Text) + Val(txtujian.Text) + Val(txtadministrasi.Text)) - Val(txtbeasiswa.Text)

txtbayar.SetFocus

End If

End Sub

Private Sub txtbayar_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

txtkembali.Text = Val(txtbayar.Text) - Val(txttotal.Text)

nonaktif

cmdsave.SetFocus

End If

End Sub

Read More

Visual Basic ( Form Siswa )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0 (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)
3. Microsoft Windows Common Controls-2 6.0 (SP6)

Listing Modul :


Public conn As New ADODB.Connection
Public rssiswa As New ADODB.Recordset

Public Sub openDB()
Set conn = New ADODB.Connection
Set rssiswa = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\Sekolah.mdb"
End Sub

Listing/Coding :

Sub aktif()

txtnis.Enabled = True

txtnama.Enabled = True

txtalamat.Enabled = True

txttempat.Enabled = True

tgllahir.Enabled = True

cmbjenis.Enabled = True

cmbagama.Enabled = True

cmbjurusan.Enabled = True

txtkeahlian.Enabled = True

txtkelas.Enabled = True

End Sub

Sub nonaktif()

txtnis.Enabled = False

txtnama.Enabled = False

txtalamat.Enabled = False

txttempat.Enabled = False

tgllahir.Enabled = False

cmbjenis.Enabled = False

cmbagama.Enabled = False

cmbjurusan.Enabled = False

txtkeahlian.Enabled = False

txtkelas.Enabled = False

End Sub

Sub bersih()

txtnis.Text = ""

txtnama.Text = ""

txtalamat.Text = ""

txttempat.Text = ""

cmbjenis.Text = "--Silakan Pilih--"

cmbagama.Text = "--Silakan Pilih--"

cmbjurusan.Text = "--Silakan Pilih--"

txtkeahlian.Text = ""

txtkelas.Text = ""

End Sub

Sub tampil()

With rssiswa

If Not .EOF Then

txtnis.Text = !nis

txtnama.Text = !nama

txtalamat.Text = !alamat

txttempat.Text = !tempat_lahir

tgllahir.Value = !tanggal_lahir

cmbjenis.Text = !jenis_kelamin

cmbagama.Text = !agama

cmbjurusan.Text = !jurusan

txtkeahlian.Text = !keahlian

txtkelas.Text = !kelas

End If

End With

End Sub

Private Sub Form_Load()

Call openDB

conn.CursorLocation = adUseClient

rssiswa.Open "select * from Siswa", conn

Set gridsiswa.DataSource = rssiswa.DataSource

End Sub

Private Sub Form_Activate()

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = False

cmdedit.Enabled = False

cmddelete.Enabled = False

cmdexit.Enabled = True

cmdinput.SetFocus

cmbjenis.AddItem "Pria"

cmbjenis.AddItem "Wanita"

cmbagama.AddItem "Islam"

cmbagama.AddItem "Kristen"

cmbagama.AddItem "Hindu"

cmbagama.AddItem "Budha"

cmbjurusan.AddItem "Teknik Mesin"

cmbjurusan.AddItem "Teknik Informatika"

cmbjurusan.AddItem "Teknik Sipil"

End Sub

Private Sub cmdinput_Click()

aktif

bersih

txtnis.SetFocus

cmdinput.Enabled = False

cmdsave.Enabled = True

cmdcancel.Enabled = True

cmddelete.Enabled = True

cmdedit.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdsave_Click()

If cmdsave.Caption = "&Save" Then

Dim sqlsave As String

sqlsave = "insert into Siswa values('" & txtnis & "','" & txtnama & "','" & txtalamat & "','" & txttempat & "','" & tgllahir & "','" & cmbjenis & "','" & cmbagama & "','" & cmbjurusan & "','" & txtkeahlian & "','" & txtkelas & "')"

conn.Execute sqlsave

MsgBox "Data Telah Tersimpan"

Form_Load

Else

Dim sqledit As String

sqledit = "update Siswa set nama='" & txtnama & "',alamat='" & txtalamat & "',tempat_lahir ='" & txttempat & "',tanggal_lahir='" & tgllahir & "',jenis_kelamin='" & cmbjenis & "',agama='" & cmbagama & "',jurusan='" & cmbjurusan & "',keahlian = '" & txtkeahlian & "',kelas='" & txtkelas & "' where nis = '" & txtnis & "'"

conn.Execute sqledit

MsgBox "Data Telah Diperbaharui"

Form_Load

End If

nonaktif

cmdsave.Enabled = True

cmdsave.Caption = "&Save"

cmdsave.Enabled = False

cmdinput.Enabled = True

cmdcancel.Enabled = True

cmdedit.Enabled = True

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdedit_Click()

aktif

tampil

txtnis.Enabled = False

txtnama.SetFocus

cmdsave.Caption = "&Update"

cmdsave.Enabled = True

cmdinput.Enabled = True

cmdedit.Enabled = False

cmddelete.Enabled = True

cmdexit.Enabled = True

cmdcancel.Enabled = True

End Sub

Private Sub cmdcancel_Click()

p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

bersih

nonaktif

End If

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdedit.Enabled = False

cmdcancel.Enabled = False

cmddelete.Enabled = False

cmdexit.Enabled = True

End Sub

Private Sub cmddelete_Click()

Call openDB

rssiswa.Open "delete from Siswa where nis = '" & txtnis & "'", conn

MsgBox "Data Telah Terhapus"

Form_Load

bersih

nonaktif

cmdinput.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdexit_Click()

p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

End

End If

End Sub

Private Sub cmdcari_Click()

Call openDB

rssiswa.Open "select * from Siswa where nis='" & txtcari & "'", conn

If rssiswa.EOF Then

MsgBox "Data Tidak Ditemukan"

txtcari.Text = ""

Else

MsgBox "Data Sudah Ada"

tampil

nonaktif

txtcari.Text = ""

End If

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdedit.Enabled = True

cmdcancel.Enabled = True

cmddelete.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmbjurusan_Click()

If cmbjurusan.Text = "Teknik Mesin" Then

txtkeahlian.Text = "Mekanik Otomotif"

ElseIf cmbjurusan.Text = "Teknik Informatika" Then

txtkeahlian.Text = "Programing"

Else

txtkeahlian.Text = "Konstruksi"

End If

txtkelas.SetFocus

End Sub

Private Sub txtnis_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call openDB

rssiswa.Open "select * from Siswa where nis = '" & txtnis & "'", conn

If Not rssiswa.EOF Then

MsgBox "Data Sudah Ada"

tampil

nonaktif

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdedit.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

cmdinput.SetFocus

Else

p = MsgBox("Data Tidak Ada, Apa Mau Menambah Data..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

aktif

txtnis.Enabled = False

txtnama.Text = ""

txtalamat.Text = ""

txttempat.Text = ""

cmbjenis.Text = "--Silakan Pilih--"

cmbagama.Text = "--Silakan Pilih--"

cmbjurusan.Text = "--Silakan Pilih--"

txtkeahlian.Text = ""

txtkelas.Text = ""

txtnama.SetFocus

cmdinput.Enabled = False

cmdsave.Enabled = True

cmdedit.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

Else

nonaktif

bersih

End If

End If

End If

End Sub

Read More

Visual Basic ( Form Transaksi Kue ( Lanjutan Form Kue ) )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0 (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)

Listing Modul :


Public conn As New ADODB.Connection
Public rskue As New ADODB.Recordset
Public rstransaksi As New ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rskue = New ADODB.Recordset
Set rstransaksi = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bakery.mdb"
End Sub

Listing / Coding :

Sub auto()

Dim no As String

Dim noint As Integer

With rstransaksi

If .RecordCount = 0 Then

no = "0001"

Else

.MoveLast

noint = Val(Right(!notrans, 4)) + 1

no = Right("0000" & noint, 4)

End If

End With

txtnotrans.Text = no

End Sub

Sub aktif()

txtnotrans.Enabled = True

txtkode.Enabled = True

txtproduct.Enabled = True

txtjenis.Enabled = True

txtrasa.Enabled = True

txtharga.Enabled = True

txtjumbel.Enabled = True

txttobay.Enabled = True

txtbayar.Enabled = True

txtkembali.Enabled = True

End Sub

Sub nonaktif()

txtnotrans.Enabled = False

txtkode.Enabled = False

txtproduct.Enabled = False

txtjenis.Enabled = False

txtrasa.Enabled = False

txtharga.Enabled = False

txtjumbel.Enabled = False

txttobay.Enabled = False

txtbayar.Enabled = False

txtkembali.Enabled = False

End Sub

Sub bersih()

txtnotrans.Text = ""

txtkode.Text = ""

txtproduct.Text = ""

txtjenis.Text = ""

txtrasa.Text = ""

txtharga.Text = ""

txtjumbel.Text = ""

txttobay.Text = ""

txtbayar.Text = ""

txtkembali.Text = ""

End Sub

Sub tampil()

With rskue

If Not .EOF Then

txtkode.Text = !kdkue

txtproduct.Text = !product

txtjenis.Text = !jenis_kue

txtrasa.Text = !rasa_kue

txtharga.Text = !harga

End If

End With

End Sub

Private Sub Form_Load()

Call koneksi

conn.CursorLocation = adUseClient

rstransaksi.Open "select * from Transaksi", conn

Set gridtransaksi.DataSource = rstransaksi.DataSource

End Sub

Private Sub Form_Activate()

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = False

cmdcancel.Enabled = False

cmdexit.Enabled = True

cmdinput.Enabled = True

End Sub

Private Sub Timer1_Timer()

txttanggal.Text = Format(Date, "dd-mm-yyyy")

txttanggal.Enabled = False

End Sub

Private Sub cmdinput_Click()

aktif

bersih

auto

txtnotrans.Enabled = False

txtkode.SetFocus

cmdinput.Enabled = False

cmdsave.Enabled = True

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdsave_Click()

Dim sqlsave As String

sqlsave = "insert into Transaksi values('" & txtnotrans.Text & "','" & txttanggal.Text & "','" & txtkode.Text & "','" & txtproduct & "','" & txtjenis.Text & "','" & txtrasa.Text & "','" & txtharga.Text & "','" & txtjumbel.Text & "','" & txttobay.Text & "')"

conn.Execute sqlsave

MsgBox "Data Telah Tersimpan"

Form_Load

nonaktif

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdcancel_Click()

p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

nonaktif

bersih

End If

cmdinput.Enabled = True

cmdsave.Enabled = False

cmdcancel.Enabled = False

cmddelete.Enabled = False

cmdexit.Enabled = True

End Sub

Private Sub cmddelete_Click()

Call koneksi

rstransaksi.Open "delete from Transaksi where notrans = '" & txtnotrans.Text & "'", conn

MsgBox "Data Telah Terhapus"

Form_Load

nonaktif

bersih

cmdinput.Enabled = True

cmdsave.Enabled = False

cmddelete.Enabled = True

cmdcancel.Enabled = True

cmdexit.Enabled = True

End Sub

Private Sub cmdexit_Click()

p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")

If p = vbYes Then

End

End If

End Sub

Private Sub txtkode_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call koneksi

rskue.Open "select * from Kue where kdkue = '" & txtkode.Text & "'", conn

If rskue.EOF Then

MsgBox "Kode Yang Anda Masukan Tidak Ada"

txtkode.Text = ""

txtkode.SetFocus

Else

tampil

txtjumbel.SetFocus

End If

End If

End Sub

Private Sub txtjumbel_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

txttobay.Text = Val(txtjumbel.Text) * Val(txtharga.Text)

txtbayar.SetFocus

End If

End Sub

Private Sub txtbayar_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

MsgBox "Terima Kasih"

txtkembali.Text = Val(txtbayar.Text) - Val(txttobay.Text)

nonaktif

cmdsave.SetFocus

End If

End Sub

Read More

Visual Basic ( Form Kue )

Komponen Yang Digunakan :

1. Microsoft Ado Data Control 6.0  (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)

Listing Modul :

Public conn As New ADODB.Connection
Public rskue As New ADODB.Recordset

Public Sub koneksi()
Set conn = New ADODB.Connection
Set rskue = New ADODB.Recordset
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Bakery.mdb"
End Sub

Listing/Coding :


Sub aktif()
txtkode.Enabled = True
cmbproduct.Enabled = True
txtjenis.Enabled = True
lrasa.Enabled = True
txtharga.Enabled = True
End Sub

Sub nonaktif()
txtkode.Enabled = False
cmbproduct.Enabled = False
txtjenis.Enabled = False
lrasa.Enabled = False
txtharga.Enabled = False
End Sub

Sub bersih()
txtkode.Text = ""
cmbproduct.Text = "--Silakan Pilih--"
txtjenis.Text = ""
txtharga.Text = ""
End Sub

Sub tampil()
With rskue
If Not .EOF Then
txtkode.Text = !kdkue
cmbproduct.Text = !product
txtjenis.Text = !jenis_kue
lrasa.Text = !rasa_kue
txtharga.Text = !harga
End If
End With
End Sub

Private Sub Form_Load()
Call koneksi
conn.CursorLocation = adUseClient
rskue.Open "select * from Kue", conn
Set gridkue.DataSource = rskue.DataSource
End Sub

Private Sub Form_Activate()
nonaktif
bersih
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
cmddelete.Enabled = False
cmdinput.SetFocus
lrasa.Clear
cmbproduct.AddItem "Bread"
cmbproduct.AddItem "Cake"
cmbproduct.AddItem "Pastry"
End Sub

Private Sub cmdinput_Click()
aktif
bersih
lrasa.Clear
cmdinput.Enabled = False
cmdsave.Enabled = True
cmdedit.Enabled = True
cmdcancel.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
txtkode.SetFocus
End Sub

Private Sub cmdsave_Click()
If cmdsave.Caption = "&Save" Then
Dim sqlsave As String
sqlsave = "insert into Kue values('" & txtkode.Text & "','" & cmbproduct.Text & "','" & txtjenis.Text & "','" & lrasa.Text & "','" & txtharga.Text & "')"
conn.Execute sqlsave
MsgBox "Data Telah Tersimpan"
Form_Load
Else
Dim sqledit As String
sqledit = "update Kue set product = '" & cmbproduct & "',jenis_kue = '" & txtjenis.Text & "',rasa_kue = '" & lrasa.Text & "',harga = '" & txtharga.Text & "' where kdkue = '" & txtkode.Text & "'"
conn.Execute sqledit
MsgBox "Data Telah Diperbaharui"
Form_Load
End If
nonaktif
cmdsave.Enabled = True
cmdsave.Caption = "&Save"
cmdsave.Enabled = False
cmdinput.Enabled = True
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdedit_Click()
aktif
tampil
txtkode.Enabled = False
cmbproduct.SetFocus
cmdsave.Caption = "&Update"
cmdinput.Enabled = True
cmdedit.Enabled = False
cmdsave.Enabled = True
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdcancel_Click()
p = MsgBox("Yakin Ingin Membatalkan Penginputan..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
nonaktif
bersih
End If
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
cmdexit.Enabled = True
End Sub

Private Sub cmddelete_Click()
Call koneksi
rskue.Open "delete from Kue where kdkue = '" & txtkode.Text & "'", conn
MsgBox "Data Telah Terhapus"
Form_Load
bersih
nonaktif
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdcancel.Enabled = True
cmdedit.Enabled = True
cmddelete.Enabled = True
cmdexit.Enabled = True
End Sub

Private Sub cmdexit_Click()
p = MsgBox("Yakin Ingin Keluar Dari Program Ini..?!", vbQuestion + vbYesNo, "Question")
If p = vbYes Then
End
End If
End Sub

Private Sub cmdtop_Click()
With rskue
rskue.MoveFirst
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdback_Click()
With rskue
rskue.MovePrevious
If rskue.BOF Then
MsgBox "Sudah Diawal Record!", vbCritical, "Pesan"
rskue.MoveFirst
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdnext_Click()
With rskue
rskue.MoveNext
If rskue.EOF Then
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
rskue.MoveLast
End If
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmdbott_Click()
With rskue
rskue.MoveLast
MsgBox "Sudah Diakhir Record!", vbCritical, "Pesan"
tampil
cmdinput.Enabled = True
cmdsave.Enabled = False
cmdedit.Enabled = False
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdexit.Enabled = True
End With
End Sub

Private Sub cmbproduct_Click()
If cmbproduct.Text = "Bread" Then
txtjenis.Text = "Classic"
lrasa.Clear
lrasa.AddItem "Chocolate"
lrasa.AddItem "Keju"
lrasa.AddItem "Baso Keju"
ElseIf cmbproduct.Text = "Cake" Then
txtjenis.Text = "Taart"
lrasa.Clear
lrasa.AddItem "Black Forest"
lrasa.AddItem "Mocca Taart"
lrasa.AddItem "Lemon Taart"
Else
txtjenis.Text = "Pastry"
lrasa.Clear
lrasa.AddItem "Chiken Pie"
lrasa.AddItem "Danish Raisin"
lrasa.AddItem "Coissant Coklat"
End If
End Sub

Private Sub lrasa_Click()
If txtjenis.Text = "Classic" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "7000"
Else
txtharga.Text = "8000"
End If
ElseIf txtjenis.Text = "Taart" Then
If lrasa.ListIndex = 0 Then
txtharga.Text = "277000"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "215000"
Else
txtharga.Text = "215000"
End If
Else
If lrasa.ListIndex = 0 Then
txtharga.Text = "6500"
ElseIf lrasa.ListIndex = 1 Then
txtharga.Text = "6500"
Else
txtharga.Text = "6500"
End If
End If
End Sub

Read More