Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
MEMBUAT FORM TRANSAKSI PERSEWAAN VCD 1. Buatlah desain seperti gambar berikut ini. Desain kali ini sedikit lebih rumit karena didalamnya kita akan menggunakan dua buah Panel, yang masing-masing panel mewakili satu tabel, yang diletakkan pada halaman pertama Page Control :
2. Ubahlah properties untuk desain form diatas : Componen Pallete Tab Object Win32
Object Inspector Properties Keterangan TabSheet1, Caption I&nput dan Edit Sewa Page Control TabSheet2, Caption &Lihat Data Persewaan DateTimePicker1 Name DtpTglSewa Edit Button1
Standard
Button2 Button3 Button4
Name Name Caption Name Caption Name Caption Name Caption
EdNoSewa BtCek &Cek BtInputPLG Input P&elanggan BtBatal2 Bata&l BtTambahVCD Tambah VCD
Praktikum 11
Pemrograman Delphi 7
Button5 Button6 Button7 Button8 Button9 Button10 ListBox1 ListBox2 ListBox3 StaticText1
StaticText2
StaticText3
StaticText4 Additional StaticText5
StaticText6
StaticText7
StaticText8
BDE
Table1
Table2
Name Caption Name Caption Name Caption Name Caption Name Caption Name Caption Name Name Name Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize Name BorderStyle AutoSize DatabaseName Name TableName AutoRefresh Active DatabaseName
Imam Gunawan, S.Kom BtHapusDaftar Hapus Dari Daftar BtTambah &Tambah BtEdit &Edit BtSimpan &Simpan BtBatal &Batal BtKeluar &Keluar LstKode LstJudul LstJenis StKodePlg SbsSunken False StNamaPLG SbsSunken False StAlamatPLG SbsSunken False StStatus SbsSunken False StTotal SbsSunken False StJMLVCD SbsSunken False StTarif SbsSunken False StLamaSewa SbsSunken False RentalVCD tVCD VCD.db True True RentalVCD
Praktikum 11
Pemrograman Delphi 7
Table3
Table4
Table5
Table6
DataSource DataAccess
DataSource DataSource
Name TableName AutoRefresh Active DatabaseName Name TableName AutoRefresh Active DatabaseName Name TableName AutoRefresh Active DatabaseName Name TableName AutoRefresh Active DatabaseName Name TableName AutoRefresh Active DataSet Name DataSet Name DataSet Name
Imam Gunawan, S.Kom tPelanggan Pelanggan.db True True RentalVCD tTarif Bantu.db True True RentalVCD tSewa Persewaan.db True True RentalVCD tVCD2 VCD.db True True RentalVCD tPelanggan2 Pelanggan.db True True tVCD DsVCD tPelanggan DsPelanggan tSewa DsSewa
3. Berikutnya masukan Panel ke Dalam PageControl pada halaman 1 untuk membuat desain tampilan tabel pelanggan seperti dibawah ini :
Praktikum 11
Pemrograman Delphi 7
Panel
Imam Gunawan, S.Kom
Edit
Button
DBGrid Animate
StaticText
4. Rubah Propertiesnya : Componen Pallete Tab Object Panel Standard
Edit Button1
Additional
StaticText
DataControl
DBGrid
Win32
Animate
Object Inspector Properties Keterangan Name PnPelanggan Caption (Kosongi) Name EdCariNama Text (Kosongi) Name BtBatal3 Caption B&atal Double Klick Untuk Caption Memasukan Data Pelanggan BorderStyle sbsSunken Auto Size False DataSource DsPelanggan Name AnmPelanggan CommonAVI aviFindFile
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
Active False 5. Berikutnya buat sub desain form yang kedua, yang masih berada pada halaman1 PageControl. Sebagai berikut : Panel
Animate
Edit
StaticText
Button
DBGrid
6. Atur Propertiesnya : Componen Pallete Tab Object Panel Standard
Edit Button1
Additional
StaticText
Object Inspector Properties Keterangan Name PnVCD Caption (Kosongi) Name EdCariJudul Text (Kosongi) Name BtBatal4 Caption Batal Double Klick Untuk Caption Memasukan Data VCD BorderStyle sbsSunken Auto Size False
Praktikum 11
Pemrograman Delphi 7
DataControl
DBGrid
Win32
Animate
DataSource Name CommonAVI Active
Imam Gunawan, S.Kom DsVCD AnmVCD aviFindFile False
7. Selanjutnya Desain PageControl Halaman ke 2 sebagai berikut :
DBNavigator DBGrid RadioGroup
Edit DateTimePicker Button1 Button2
StaticText1
StaticText3 StaticText2
StaticText4
8. Atur Propertiesnya : Componen Pallete Tab Object Edit Standard
Button1 Button2 RadioGroup
Object Inspector Properties Keterangan Name EdCari Name BtHapus1 Caption Hap&us Satu Name BtHapusBanyak Caption Hapus / Transaksi Name RgCari Items Nomor Sewa Tanggal Sewa Kode Pelanggan
Praktikum 11
Win32
Pemrograman Delphi 7
DateTimePicker StaticText1 StaticText2
Additional StaticText3 StaticText4 DataControl
DBGrid DBNavigator
Caption Name Visible Name BorderStyle Name BorderStyle Name BorderStyle Name BorderStyle DataSource DataSource VisibleButtons
Imam Gunawan, S.Kom Kode VCD Pencarian Data DtpCari False StCariNama sbsSunken StCariAlamat sbsSunken StCariJudul sbsSunken StCariJenis sbsSunken DsSewa DsSewa [nbFirst, nbPrior, nbNext, nbLast]
9. Deklarasikan beberapa procedure berikut ini : ….. procedure procedure procedure procedure procedure …..
SeleksiItem(Lst:TListBox); BuatNoSewa; AktifkanKode; Aktifkan; CariKeterangan;
10. Deklarasikan beberapa Variabel Global, sbb : ….. var FrmSewa: TFrmSewa; Konfirmasi:Integer; Edit, Ketemu:Boolean; Nomor:String[10]; 11. Buat kode program untuk procedure SeleksiItem : Procedure TFrmSewa.SeleksiItem(Lst:TListBox); begin LstKode.ItemIndex:=Lst.ItemIndex; LstJudul.ItemIndex:=Lst.ItemIndex; LstJenis.ItemIndex:=Lst.ItemIndex; end;
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
//Double Klick LstKode procedure TFrmSewa.LstKodeClick(Sender: TObject); begin SeleksiItem(LstKode); end; //Double Klick LstJudul procedure TFrmSewa.LstJudulClick(Sender: TObject); begin SeleksiItem(LstJudul); end; //Double Klick LstJenis procedure TFrmSewa.LstJenisClick(Sender: TObject); begin SeleksiItem(LstJenis); end;
12. Buat kode program untuk membuat Nomor Sewa yang akan dibuat dengan format : ttmm.99999 tt : untuk menampung 2 digit tahun terakhir mm : untuk menampung 2 digit angka bulan 99999 : untuk menampung urutan data yang disesuaikan atau dilengkapi dengan angka 0 Procedure TFrmSewa.BuatNoSewa; var Tanggal, Hasil, NSewa:String[10]; Th, Bl :String[2]; NilaiU:String[5]; i, n:Integer; begin Tanggal:=FormatDateTime('dd/mm/yyyy',date); //ambil tahun for i:=9 to 10 do begin Th:=Th+Tanggal[i]; end; //ambil bulan for i:=4 to 5 do begin Bl:=Bl+Tanggal[i]; end; //buat nilai urutan
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
if tSewa.RecordCount=0 then n:=1 else begin tSewa.IndexName:='IdxNoSewa'; tSewa.Last; NSewa:=tSewa['NoSewa']; //ambil dari kanan sebanyak 5 karakter for i:=6 to 10 do begin NilaiU:=NilaiU+NSewa[i]; end; n:=StrToInt(NilaiU)+1; end; //gabung hasil pembuatan NoSewa case Length(trim(IntToStr(n))) of 1: Hasil:=Th+bl+'.'+'0000'+Trim(IntToStr(n)); 2: Hasil:=Th+bl+'.'+'000'+Trim(IntToStr(n)); 3: Hasil:=Th+bl+'.'+'00'+Trim(IntToStr(n)); 4: Hasil:=Th+bl+'.'+'0'+Trim(IntToStr(n)); 5: Hasil:=Th+bl+'.'+Trim(IntToStr(n)); end; EdNoSewa.Text:=Hasil; EdNoSewa.SelStart:=length(trim(Hasil)); end;
13. Buat kode program untuk mengaktifkan komponen-komponen yang ada : procedure TFrmSewa.AktifkanKode; begin BtCek.Enabled:=True; BtCek.Default:=True; BtTambah.Enabled:=False; BtEdit.Enabled:=False; BtBatal.Enabled:=True; EdNoSewa.Enabled:=True; EdNoSewa.Color:=clWhite; if Edit=False then BuatNoSewa; EdNoSewa.SetFocus; end; 14. Buat kode program untuk procedure aktifkan :
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
procedure TFrmSewa.Aktifkan; var Lama:Integer; begin If Edit=False then EdNoSewa.Enabled:=False; LstKode.Clear; LstJudul.Clear; LstJenis.Clear; LstKode.Enabled:=True; LstJudul.Enabled:=True; LstJenis.Enabled:=True; LstKode.Color:=clWhite; LstJudul.Color:=clWhite; LstJenis.Color:=clWhite; //atur tombol BtCek.Enabled:=False; BtCek.Default:=False; BtInputPlg.Enabled:=True; BtBAtal2.Enabled:=True; BtTambahVCD.Enabled:=True; BtHapusdaftar.Enabled:=True; BtSimpan.Enabled:=True; //Tampilkan tarif sewa Ketemu:=tTarif.FindKey(['S']); if Ketemu=True then StTarif.Caption:=tTarif['Nilai'] else StTarif.Caption:='0'; //tampilkan tanggal DtpTglSewa.Enabled:=True; DtpTglSewa.Color:=clWhite; DtpTglSewa.Date:=Date; //cari ketetetapan lama sewa berdasarkan tabel bantu tTarif.IndexName:=''; Ketemu:=tTarif.FindKey(['L']); if Ketemu=True then lama:=tTArif['Nilai'] else lama:=0; StLamaSewa.Caption:=IntToStr(Lama); end; 15. Buat kode program untuk procedure CariKeterangan : procedure TFrmSewa.CariKeterangan; begin if tSewa.RecordCount=0 then
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
begin StcariNama.Caption:=''; StCariAlamat.Caption:=''; StCariJudul.Caption:=''; StCariJenis.Caption:=''; end else begin //cari keterangan pelanggan tPelanggan2.IndexName:=''; Ketemu:=tPelanggan2.FindKey([tSewa['KodePLG']]); if Ketemu=True then begin StcariNama.Caption:=tPelanggan2['Nama']; StCariAlamat.Caption:=tPelanggan2['Alamat']; end else begin StcariNama.Caption:='KodePLG tidak ada...'; StCariAlamat.Caption:='Data hilang...'; end; //cari keterangan VCD tVCD2.IndexName:=''; Ketemu:=tVCD2.FindKey([tSewa['KodeVCD']]); if Ketemu=True then begin StCariJudul.Caption:=tVCD2['Judul_Film']; if tVCD2['Jenis']='A' then StCariJenis.Caption:='ACTION' else if tVCD2['Jenis']='H' then StCariJenis.Caption:='HOROR' else if tVCD2['Jenis']='K' then StCariJenis.Caption:='KOMEDI' else if tVCD2['Jenis']='D' then StCariJenis.Caption:='DRAMA' else if tVCD2['Jenis']='N' then StCariJenis.Caption:='ANAK-ANAK' else if tVCD2['Jenis']='V' then StCariJenis.Caption:='VIDEO KLIP' else if tVCD2['Jenis']='M' then StCariJenis.Caption:='FILM MANDARIN' else StCariJenis.Caption:='FILM DOKUMENTER'; end else begin StCariJudul.Caption:='Kode VCD tidak ada...';
Praktikum 11
Pemrograman Delphi 7 StCariJenis.Caption:='Data hilang...'; end;
end; end; 16. Buat kode program untuk tombol Batal pada event OnClick : procedure TFrmSewa.BtBatalClick(Sender: TObject); begin EdNoSewa.Text:=''; EdNoSewa.Enabled:=False; DtpTglSewa.Enabled:=False; EdNoSewa.Color:=clBtnFace; DtpTglSewa.Color:=clBtnFace; StKodePlg.Caption:=''; StNamaPlg.Caption:=''; StAlamatPLG.Caption:=''; StLamaSewa.Caption:=''; StTarif.Caption:=''; StJMLVCD.Caption:=''; StTotal.Caption:=''; StStatus.Caption:=''; LstKode.Clear; LstJudul.Clear; LstJenis.Clear; LstKode.Enabled:=False; LstJudul.Enabled:=False; LstJenis.Enabled:=False; LstKode.Color:=clBtnface; LstJudul.Color:=clBtnface; LstJenis.Color:=clBtnface; //onaktifkan frame VCD dan pelanggan jika aktif BtBatal3Click(sender); BtBatal4Click(sender); //atur tombol BtCek.Enabled:=False; BtCek.Default:=False; BtTambah.Enabled:=True; BtEdit.Enabled:=True; BtSimpan.Enabled:=False; BtBatal.Enabled:=False; BtINputPlg.Enabled:=False; BtBatal2.Enabled:=False; BtTambahVCD.Enabled:=False; BtHapusDaftar.Enabled:=False; end;
Imam Gunawan, S.Kom
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
17. Buat kode program untuk memanggil kembali kode program dalam tombol batal pada event onCreate dalam form melalui object inspector : procedure TFrmSewa.FormCreate(Sender: TObject); begin BtBatalClick(Sender); Dbgrid2.Columns.RebuildColumns; end; 18. Buat kode program untuk tombol Tambah : procedure TFrmSewa.BtTambahClick(Sender: TObject); begin Edit:=False; AktifkanKode; StStatus.Caption:='Tambah Data'; end; 19. Buat kode program untuk tombol Edit : procedure TFrmSewa.BtEditClick(Sender: TObject); begin Edit:=True; AktifkanKode; StStatus.Caption:='Edit Data'; end;
20. Buat kode program untuk mengecek Nomor Sewa yang ada pada komponen Edit pada tombol Cek : procedure TFrmSewa.BtCekClick(Sender: TObject); begin if Length(Trim(EdNoSewa.Text))=0 then begin Application.MessageBox('No. Sewa masih kosong...','Cek Input',MB_IconStop); EdNoSewa.SetFocus; end else begin //set index tabel pada kunci utama tSewa.IndexName:='IdxNoSewa'; //cari data
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
Ketemu:=tSewa.FindKey([Trim(EdNoSewa.Text)]); if Ketemu=True then //jika data ketemu //cek dulu edit atau tambah begin if Edit=True then //jika edit, tampilkan datanya begin Aktifkan; Nomor:=tSewa['NoSewa']; //digunakan untuk pengeditan //tampilkan detail //cetak data yang sama terlebih dahulu DtpTglSewa.Date:=tSewa['TglSewa']; StLamaSewa.Caption:=tSewa['LamaSewa']; StKodePLG.Caption:=tSewa['KodePLG']; StTarif.Caption:=tSewa['TarifSewa']; //masukan data pelanggan Ketemu:=tPelanggan.FindKey([tSewa['KodePLG']]); if ketemu=True then begin StNamaPlg.Caption:=tPelanggan['Nama']; StAlamatPlg.Caption:=tPelanggan['Alamat']; end else begin StNamaPlg.Caption:=tPelanggan['Kode pelanggan tidak ada...']; StAlamatPlg.Caption:=tPelanggan['Data hilang...']; end; //masukan kode VCD ke dalam daftar //gunakan perulangan Ketemu:=False; while tSewa['NoSewa']=trim(EdNoSewa.Text) do begin LstKode.Items.Append(tSewa['KodeVCD']); //masukan data VCD kedalam tdaftar film Ketemu:=tVCD.FindKey([tSewa['KodeVCD']]); if Ketemu=True then begin LstJudul.Items.Append(tVCD['Judul_Film']); LstJenis.Items.Append(tVCD['Jenis']); //karena dalam perulangan harus dikembalikan ke false Ketemu:=False; end
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
else begin LstJudul.Items.Append('Kode VCD tidak ada...'); LstJenis.Items.Append(tVCD['Data hilang...']); end; tSewa.Next; if tSewa.Eof then begin //tampilkan jumlah VCD StJMLVCD.Caption:=IntToStr(LstKode.Items.Count); //hitung biaya StTotal.Caption:=FloatToStr(LstKode.Items.Count * tSewa['TarifSewa']); exit; end; end; //tampilkan jumlah VCD StJMLVCD.Caption:=IntToStr(LstKode.Items.Count); //hitung biaya StTotal.Caption:=FloatToStr(LstKode.Items.Count * tSewa['TarifSewa']); end else begin //jika tambah aktifkan beri pesan Nosewa sudah ada application.MessageBox('No. Sewa sudah ada...','Cek Data',MB_IconInformation); EdNoSewa.Text:=''; EdNoSewa.SetFocus; end; end else //jika data tidak ketemu //cek dulu edit atau tambah begin if Edit=True then begin //beri pesan NoSewa tidak ada application.MessageBox('No. Sewa tidak ada...','Cek Data',MB_IconInformation); EdNoSewa.Text:=''; EdNoSewa.SetFocus; end
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
else //aktifkan objek input Aktifkan; end end; end; 21. Buat kode program pada tombol input pelanggan yang berfungsi untuk memunculkan komponen Panel yang didalamnya terdapat tabel pelanggan atau data member yang sebelumnya sudah dibuat desainnya dalam PageControl halaman 1 : procedure TFrmSewa.BtInputPLGClick(Sender: TObject); begin BtInputPLG.Enabled:=False; BtBatal2.Enabled:=False; pnPelanggan.Visible:=True; //atur posisi panel pelanggan //supaya berada pada pojok kanan atas PnPelanggan.Left:=PnSewa.Width - PnPelanggan.Width; PnPelanggan.Top:=PnSewa.Top; EdCariNama.Text:=''; EdCariNama.SetFocus; //aktifkan animasi cari AnmPelanggan.Active:=True; //refresh tabel tPelanggan.Active:=True; end; 22. Setelah muncul panel Pelanggan, buat kode program untuk menutup panel tersebut, melalui tombol Batal dalam komponen Panel untuk tabel pelanggan : procedure TFrmSewa.BtBatal3Click(Sender: TObject); begin PnPelanggan.Visible:=False; BtInputPLG.Enabled:=True; BtBatal2.Enabled:=True; //menonaktifkan animasi find file Anmpelanggan.Active:=False; end; 23. Untuk proses memasukan data pelanggan ke dalam form, dilakukan dengan mengklik dua kali pada komponen DBGrid. Untuk itu masukan kode program berikut ini, pada event OnDBClick pada DBGrid melalui Object Inspector : procedure TFrmSewa.DBGrid1DblClick(Sender: TObject); begin //kirim data dari tabel ke form transaksi
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
StKodePlg.Caption:=tPelanggan['KodePlg']; StNamaPlg.Caption:=tPelanggan['Nama']; StAlamatPlg.Caption:=tPelanggan['Alamat']; //tutup kembali tabel pelanggan BtBatal3Click(Sender); end; 24. Setelah memasukan data ke dalam form, ada kalanya data yang dimasukan user ke dalam form salah. Untuk mengatasinya, terlebih dahulu data yang salah yang masuk ke dalam form kita hapus, kemudian proses input data pelanggan bisa diulangi lagi dari awal. Kode program berikut ini berfungsi untuk membersihkan tulisan pada komponen StaticTetx data pelanggan :
procedure TFrmSewa.BtBatal2Click(Sender: TObject); begin stKodePLG.Caption:=''; StNamaPLG.Caption:=''; StAlamatPLG.Caption:=''; end; 25. Dalam komponen Panel pada Tabel pelanggan juga dilengkapi dengan Fasilitas untuk mencari nama pelanggan melalui komponen Edit. Buat kode program untuk mencari data pelanggan berdasarkan nama : procedure TFrmSewa.EdCariNamaChange(Sender: TObject); begin if length(trim(EDCariNama.Text))=0 then exit else begin tPelanggan.IndexName:='IdxNama'; tPelanggan.FindNearest([trim(EDCariNama.Text)]); end; end; 26. Buat kode program untuk Tombol Tambah VCD, untuk memunculkan panel VCD yang berfungsi untuk memunculkan Panel yang berisi tabel VCD ke dalam Form : procedure TFrmSewa.BtTambahVCDClick(Sender: TObject); begin BtTambahVCD.Enabled:=False; BtHapusDaftar.Enabled:=False; PnVCD.Visible:=True; //atur posisi panel VCD //supaya berada pada pojok kiri data VCD PnVCD.Left:=GbVCD.Left;
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
PnVCD.Top:=GbVCD.Top; EdCariJudul.Text:=''; EdCariJudul.SetFocus; //aktifkan animasi cari AnmVCD.Active:=True; //refresh tabel tVCD.Active:=True; end; 27. Buat kode program untuk memasukan data VCD ke dalam Form, pada event OnDBclick DBGrid yang ada pada panel VCD melalui Objek Inspector : procedure TFrmSewa.DBGrid3DblClick(Sender: TObject); var J:integer; Cocok:Boolean; begin //CEK DULU APAKAH ADA YANG SAMA ATAU TIDAK Cocok:=false; for j:=0 to lstkode.Items.Count-1 do begin if tVCD['KodeVCD']=LstKode.Items.Strings[J] then Cocok:=True; end; if Cocok=True then Application.MessageBox('Data VCD sudah pernah dimasukan...','Cek data',MB_IconInformation) else begin //cek dulu persediaan VCD if tvcd['JML_Persediaan']<=0 then application.MessageBox('Persediaan habis...','Cek Perseiaan',MB_IconStop) else begin //kirim data dari tabel ke form transaksi LstKode.Items.Append(tVCD['KodeVCD']); LstJudul.Items.Append(tVCD['Judul_Film']); LstJenis.Items.Append(tVCD['Jenis']); //sleksi data yang baru dimasukan LstKode.ItemIndex:=LstKode.Items.Count-1; LstKode.Selected[LstKode.Items.Count-1]; seleksiItem(LstKode); //tutup kembali tabel VCD BtBatal4Click(Sender); //tampilkan jumlah VCD yang dipinjam StJMLVCD.Caption:=IntToStr(LstKode.Items.Count);
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
//Tampilkan total bayar StTotal.Caption:=FloatToStr(StrToFloat(StJMLVCD.Captio n)*StrToFloat(StTarif.Caption)); end; end; end; 28. Buat kode program untuk menghapus daftar VCD ke dalam daftar VCD yang ditampung dalam ListBox : procedure TFrmSewa.BtHapusDaftarClick(Sender: TObject); begin if LstKode.Items.Count=0 then application.MessageBox('Daftar VCD kosong...','Akses Ditolak',MB_IconStop) else begin Konfirmasi:=application.MessageBox('Anda yakin...','Konfirmasi Hapus', MB_IconQuestion Or MB_YesNO); if Konfirmasi=IdYes Then begin LstKode.DeleteSelected; LstJudul.DeleteSelected; LstJenis.DeleteSelected; end; if Lstkode.Items.Count=0 then exit else begin LstKode.ItemIndex:=LstKode.Items.Count-1; SeleksiItem(LstKode); end; end; end; 29. Buat kode program untuk menyimpan data transaksi persewaan VCD pada tombol Simpan dalam event OnClick : procedure TFrmSewa.BtSimpanClick(Sender: TObject); var i, JDaftar:Integer; //buat precedure di dalam procedure Procedure KurangiPersediaan(KVCD:String); begin tVCD.IndexName:=''; Ketemu:=tVCD.FindKey([KVCD]); if Ketemu=True then
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
begin if tVCD['JML_Persediaan']<=0 then exit else begin tVCD.Edit; tVCD['JML_Persediaan']:=tVCD['JML_Persediaan']-1; tVCD.Post; tVCD.Refresh; end; end else exit; end; begin //Cek input user if Length(Trim(StKodeplg.Caption))=0 then begin Application.MessageBox('Data pelanggan belum diisi !','Cek data',MB_IconStop); btInputPlg.SetFocus; Exit; end else if LstKode.Items.Count=0 then begin Application.MessageBox('Data VCD belum diisi !','Cek data',MB_IconStop); BtTambahVCD.SetFocus; Exit; end; //jika sudah penuh semua, dapat disimpan //cek dulu simpan tambah atau edit if Edit=False then begin Jdaftar:=LstKode.Count-1; for i:=0 to JDaftar do begin LstKode.ItemIndex:=i; tSewa.Append; tSewa['NoSewa']:=EdNoSewa.Text; tSewa['TglSewa']:=DtpTglSewa.Date; tSewa['LamaSewa']:=StLamaSewa.Caption; tSewa['KodePLG']:=StKodePLG.Caption; tSewa['KodeVCD']:=LstKode.Items.Strings[i]; tSewa['TarifSewa']:=StTarif.Caption; tSewa.Post; KurangiPersediaan(LstKode.Items.Strings[i]);
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
end; tSewa.Refresh; end else begin Jdaftar:=LstKode.Count-1; //untuk berulangan //hapus dulu yang tidak ada dalam daftar tSewa.IndexName:='IdxNoSewa'; Ketemu:=tSewa.FindKey([Nomor]); if Ketemu=True then //jika ketemu lanjutkan begin while tSewa['NoSewa']=Nomor do begin for i:=0 to JDaftar do begin if tSewa['KodeVCD']<>LstKode.Items.Strings[i] then begin //edit persediaan tVCD.IndexName:=''; Ketemu:=tVCD.FindKey([tSewa['KodeVCD']]); if Ketemu=True then begin tVCD.Edit; tVCD['JML_Persediaan']:=tVCD['JML_Persediaan']+1; tVCD.Post; tVCD.Refresh; end; //lanjutkan proses hapus tsewa.Delete; end; end; tSewa.Next; if tSewa.Eof then tSewa.First; end;//akhir penghapusan tsewa.Refresh; end else //jika tidak ketemu data berarti hilang begin application.MessageBox('Data hilang...','Cek Data',MB_IconStop); Exit; end; //simpan Edit
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
for i:=0 to JDaftar do begin //cari dulu data yang akan diedit Ketemu:=False; tSewa.IndexName:='IdxSewa'; //index dengan 2 kunci Ketemu:=tSewa.FindKey([Nomor, LstKode.Items.Strings[i]]); if Ketemu=True then tSewa.Edit else begin tsewa.Append; //jika tidak ketemu berarti ada data baru KurangiPersediaan(LstKode.Items.Strings[i]); end; //Simpan detail tSewa['NoSewa']:=EdNoSewa.Text; tSewa['TglSewa']:=DtpTglSewa.Date; tSewa['LamaSewa']:=StLamaSewa.Caption; tSewa['KodePLG']:=StKodePLG.Caption; tSewa['KodeVCD']:=LstKode.Items.Strings[i]; tSewa['TarifSewa']:=StTarif.Caption; tSewa.Post; end; tSewa.Refresh; end; BtBatalClick(Sender); //setelah selesai bersihkan end; Selanjutnya kita akan membuat kode program untuk PageControl pada halaman 2 : 30. Buat kode program untuk memilih pencarian data dalam RadioGroup : procedure TFrmSewa.RgCariClick(Sender: TObject); begin Case RgCari.ItemIndex Of 0: tSewa.IndexName:='IdxNoSewa'; 1: begin tSewa.IndexName:='IdxTglSewa'; EdCari.Visible:=False; DtpCari.Visible:=True; DtpCari.Date:=Date; DtpCari.SetFocus; Exit; end; 2: tSewa.IndexName:='IdxKodePlg'; 3: tSewa.IndexName:='IdxKodeVCD';
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
end; DtpCari.Visible:=False; EdCari.Visible:=True; EdCari.Text:=''; EdCari.SetFocus; end; 31. Buat kode program untuk komponen Edit yang akan digunakan untuk mencari data pada event OnChange : procedure TFrmSewa.EdCariChange(Sender: TObject); begin if length(Trim(EdCari.Text))=0 then exit else begin if tSewa.RecordCount=0 then application.MessageBox('Tabel kosong...','Cek Data',MB_IconExclamation) else begin Case RgCari.ItemIndex Of 0: tSewa.IndexName:='IdxNoSewa'; 2: tSewa.IndexName:='IdxKodePlg'; 3: tSewa.IndexName:='IdxKodeVCD'; end; tSewa.FindNearest([EdCari.Text]); end; end; end; 32. Buat kode program untuk DateTimePicker yang berguna untuk mencari data berdasarkan tanggal sewa pada event OnChange : procedure TFrmSewa.DtpCariChange(Sender: TObject); begin if tSewa.RecordCount=0 then application.MessageBox('Tabel kosong...','Cek Data',MB_IconExclamation) else begin tSewa.IndexName:='IdxTglSewa'; tSewa.FindNearest([DtpCari.Date]); end; end; 33. Buat kode progam untuk DBGrid dan DBNavigator :
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
procedure TFrmSewa.DBGrid2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin CariKeterangan; end; procedure TFrmSewa.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn); begin CariKeterangan; end; procedure TFrmSewa.DBGrid2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin CariKeterangan; end; procedure TFrmSewa.DBGrid2KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin CariKeterangan; end; 34. Buat kode program untuk Tombol Hapus Satu : procedure TFrmSewa.BtHapus1Click(Sender: TObject); begin if tSewa.RecordCount=0 then application.MessageBox('Tabel kosong...','Cek Tabel',MB_IconExclamation) else begin Konfirmasi:=application.MessageBox('Anda yakin, menghapus record yang aktif?', 'Konfirmasi',MB_IconQuestion or MB_YesNo); if Konfirmasi=IdYes then tsewa.Delete; tSewa.Refresh; CariKeterangan; end; end; 35. Buat kode program untuk Tombol Hapus Banyak :
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
procedure TFrmSewa.BtHapusBAnyakClick(Sender: TObject); var HapNoSewa:String[10]; begin if tSewa.RecordCount=0 then application.MessageBox('Tabel kosong...','Cek tabel',MB_IconExclamation) else begin HapNoSewa:=InputBox('Input Hapus','Masukan Nomor Sewa :','',); if Length(Trim(HapNoSewa))=0 then exit else begin //cari data tSewa.IndexName:='IdxNoSewa'; Ketemu:=tSewa.FindKey([HapNoSewa]); if Ketemu=True then begin //beri konfirmasi Konfirmasi:=Application.MessageBox('Anda yakin...', ' Hapus Per Transaksi',MB_IconQuestion or MB_YesNO); if Konfirmasi=IdYes then begin //hapus dengan perulangan while Ketemu=True do begin tSewa.Delete; Ketemu:=tSewa.FindKey([HapNoSewa]); end; tSewa.Refresh; end else exit; end else application.MessageBox('Data tidak ada...','Cari Data',MB_IconInformation); end; end; end; 36. Buat kode program untuk komonen Timer : procedure TFrmSewa.Timer1Timer(Sender: TObject);
Praktikum 11
Pemrograman Delphi 7
Imam Gunawan, S.Kom
begin Lanim.Left:=LAnim.Left-1; if (LAnim.Left + LAnim.Width)<=0 then Lanim.Left:=Panim.Width; end; 37. Buat kode program untuk FormClose : procedure TFrmSewa.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:=caFree; end; 38. Simpan form dengan nama : Usewa.Pas