Program Berkas_data_barang; uses crt; type datbar = record kobar : integer; nabar : string; harga : longint; end; var filedatbar : file of datbar; data : datbar; pil, ul : char; Procedure bukafile; begin Assign (filedatbar,'datbar.TXT'); {$I-}; Reset (filedatbar); {$I+}; End; procedure tambah; var lagi : char; ada : boolean; i : integer; nocr : word; Begin ul := 'Y'; Lagi := 'Y'; clrscr; bukafile; if IOResult <> 0 then rewrite (filedatbar); repeat clrscr; ada := false; i := 0; write ('No kode barang : '); readln (nocr); while (ada = false) and (i<> filesize(filedatbar)) do begin seek (filedatbar,i); read (filedatbar,data); if data.kobar=nocr then ada := true else inc (i); end; if (ada = true) then begin write ('Kode barang', nocr, 'ini sudah ada..!!'); end else begin seek (filedatbar,filesize(filedatbar)); data.kobar := nocr; write ('nama barang : '); readln (data.nabar); write ('Silahkan masukan harga : '); readln (data.harga); write (filedatbar,data); end; write ('tambah data lagi [Y/T] : '); lagi := Upcase (Readkey); until lagi <> 'Y'; close (filedatbar); end; Procedure tampil; var i : integer; Begin ul := 'Y'; bukafile; if IoResult <> 0 Then write ('Maaf Data masih kosong') else begin; i := 0; while not EOF (filedatbar) do begin Inc (i); Read(filedatbar,data); writeln ('Kode barangnya adalah : ', data.kobar); writeln ('Nama barangnya adalah : ', data.nabar); writeln ('Harga' , data.nabar ,' adalah : Rp.', data.harga); writeln (' '); end; close (filedatbar); end; end; Procedure cari_barang; var i, ko : integer; lagi : char; Begin ul := 'Y'; lagi := 'Y'; Repeat Write ('Silahkan Masukan Kode barang yang anda Cari : '); readln (ko); bukafile; {pemanggilan Prosedur buka file} If IoResult <> 0 Then write ('Maaf Mas Bro kode barang tidak ada..!') else begin i := 0; while not EOF (filedatbar) do begin read (filedatbar,data); if data.kobar = ko then begin Inc (i); writeln ('Kode barangnya adalah : ', data.kobar); writeln ('Nama barangnya adalah : ', data.nabar); writeln ('Harga' , data.nabar ,' adalah : Rp.', data.harga); writeln (' ') end; end; close (filedatbar); end; writeln; Write ('Mau mencari barang lagi.. ??? '); lagi :=upcase (readkey); until lagi <> 'Y'; end; Begin clrscr; repeat writeln ('DAFTAR MENU PROGRAM'); writeln; write ('1. Tambah data barang.'); writeln; write ('2. Tampilkan semua data barang.'); writeln; write ('3. Tampilkan data barang berdasarkan kode barang.'); writeln; write ('4. Keluar.'); writeln; Write ('Silahkan Masukan No. menu = '); readln (pil); case pil of '1' : tambah; '2' : tampil; '3' : cari_barang; end; until (ul <> 'Y') or (pil='4'); end.
Senin, 19 Desember 2011
Mencari suatu data dari file (penyimpanan) di pascal
Mungkin yang sudah atau yang lagi belajar pascal akan dan pasti bertemu dengan yang namanya "file" dalam pemerograman pascal, baik itu file bertipe, tidak bertipe atau file text, berikut ini sedikit program mencari suatu data barang yang sebelumnya data barang sudah di inputkan oleh user, agar tidak lupa dan mudah diingat maka saya tulis saja disini.. :D
Langganan:
Posting Komentar (Atom)
pertamax gan :D
BalasHapusSeadanya aja ya gan,, heuheu
BalasHapus