Praktikum 11 Pemrograman Delphi 7 Imam Gunawan, S.Kom MEMBUAT FORM TRANSAKSI PERSEWAAN VCD

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