Program Input, Edit, Cetak Library Book

1 Comment
Program Data_Buku_Perpustakaan;

uses wincrt;
type Buku=Record
         Kodebuku    :integer;
         Judul        :string;
         Pengarang    :String;
         Tahun        :Integer;
         Harga        :Integer;
     end;
var
   Filebuku:file of buku;
   Data:buku;
   Pil,Ul:Char;

procedure Menu;
begin
clrscr;
writeln('..:::Menu Pilihan:::...');
writeln('=======================');
writeln('1. Input Data Library Book');
writeln('2. Edit Data Library Book');
writeln('3. Cetak Data Library Book');
writeln('4. Keluar');
writeln;
write('Pilih Angka [1-4]  : ');Pil:=Readkey;
end;

procedure BukaFile;
begin
     Assign(Filebuku,'buku.dat');
     {$I-};
     Reset(Filebuku);
     {$I+};
End;

procedure Input;
var
   Lagi:Char;
   Ada:boolean;
   i:integer;
   Nocr:integer;
   begin
   Ul:='Y';
   Lagi:='Y';
   Clrscr;
bukaFile;
if IOResult<>0 then
Rewrite(Filebuku);

Repeat
Clrscr;
    ada:=False;
    I:=0;
Writeln('..:::Input Data Buku:::...');
writeln('===============================');
writeln;
write('Kode Buku        : ');Readln(Nocr);
    while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
     Seek(Filebuku,i);
     read(filebuku,Data);
     if Data.Kodebuku=Nocr then
     Ada:=true
     else
     inc(i);
End;
     if (Ada=True) then
     begin
writeln('Kode Buku"',Nocr,'"Kode Ini Sudah Ada');
     end
     else
     begin
     seek(Filebuku,Filesize(Filebuku));
     Data.Kodebuku:=Nocr;
write('Judul Buku       : ');readln(Data.Judul);
write('Nama Pengarang   : ');readln(Data.Pengarang);
write('Tahun Buku       : ');readln(Data.Tahun);
write('Harga Buku       : ');readln(Data.Harga);
     write(Filebuku,Data);
     end;
write('Mau Tambah Data Lagi [Y/T]: ');Lagi:=Upcase(readkey);
     Until Lagi<>'Y';
     Close(Filebuku);
     end;

procedure Edit;
var
   Lagi:Char;
   Ada:boolean;
   i:integer;
   Nocr:integer;
begin
   Ul:='Y';
   Lagi:='Y';
Clrscr;
BukaFile;
   if IOResult<>0 then
   write('Data masih Kosong..!')
else

begin
Repeat
Clrscr;
ada:=False;
i:=0;
Writeln('...:::Edit Data Buku:::...');
writeln('===============================');
writeln;
Write('Kode Buku     : ');readln(Nocr);
while (Ada=False) And (i<>Filesize(Filebuku)) do
begin
seek(Filebuku,i);
Read(Filebuku,data);
if Data.Kodebuku=Nocr then
begin
ada:=true;
Writeln('Judul Buku : ',Data.Judul);
writeln('Pengarang  : ',Data.Pengarang);
Writeln('Tahun BUku : ',Data.Tahun);
writeln('Harga Buku : ',Data.Harga);
end
else
Inc(i);
End;
if (Ada=True) then
begin
data.Kodebuku:=Nocr;
Write('Judul Buku   : ');readln(Data.Judul);
write('Pengarang    : ');readln(Data.Pengarang);
Write('Tahun Buku   : ');readln(Data.Tahun);
write('Harga Buku   : ');readln(Data.Harga);
Seek(Filebuku,i);
Write(Filebuku,Data);
end
else
begin
write('Kode Buku',Nocr,'Ini Tidak Ada..!');
end;
write('Mau Edit Data Lagi [Y/T]:'); Lagi:=Upcase(readkey);
Until Lagi<>'Y';
End;
close(Filebuku);
end;

procedure Cetak;
var
   I:integer;
   TIPK:Real;
   begin
   Ul:='Y';
   TIPK:=0;
   BukaFile;
   if IOResult<>0 then
   write('Maaf Data Masih Kosong...!')
   else
   begin
   Clrscr;
   Writeln('               Data Library Book               ');
   writeln('        The Largest Acewell Community          ');
   writeln;
   writeln('===============================================');
   writeln(' NO  JUDUL    PENGARANG     TAHUN  HARGA (Rp) ');
   writeln('===============================================');
   i:=0;
   while Not EOF(filebuku) do
   begin
   inc(i);
   Read(Filebuku,Data);

   writeln(i:3,Data.Judul:6,Data.Pengarang:10,data.Tahun:13,data.harga:8);
   end;

   Close(Filebuku);
   end;

   writeln;
   write('Prees Any Key to Continue...');readkey;
   end;
begin
Repeat
menu;
Case Pil Of
'1':Input;
'2':Edit;
'3':Cetak;
end;
Until(Ul<>'Y') or (Pil='4');
end.
Add a comment

1 Comment:

sangat membantu bos, sama2 alumni UYP+pondok NGALAH

22 Juli 2013 pukul 07.15 comment-delete
Posting Komentar

_Pasopati 2010 UYP™

Copyright 2011 Designing a dream come true.
Blogger Templates By:Noct.