Source Code Hapus Data dalam Pascal

Source Code Hapus Data dalam Pascal - Hapus data dalam program berikut berupa hapus data dengan menggunakan metode record.

Penghapusan data dalam record artinya dalam menghapus tidak terlebih dulu di cari data tersebut berdasarkan ID, hanya berupa penghapusan data berdasarkan batas record.

Berikut ini source code hapus data menggunakan compiler dev-pascal :

program hapus_data;
uses crt;
type
   mhs = record
      npm: string[7];
      nama: string[25];
      nilai: real;
   end;

var
   fmhs: file of mhs;
   rmhs: mhs;
   nourut,i,jml: integer;
   nocari: string[7];
   ketemu: boolean;
   lagi,ya: char;

   begin
     assign(fmhs,'mhs.dat');
     reset(fmhs);
     lagi:= 'Y';
     while upcase(lagi)='Y' do

     begin
     clrscr;
        jml:= filesize(fmhs);

        write('Nomor Record yang di Hapus (1  -',jml:3,') ? ');
        readln(nourut);
        writeln;

        if (nourut < 1) or (nourut > jml) then
           writeln('Tidak Ada No Record ini !!!')
        else
        begin
           for i:= nourut to jml do
           begin
              seek(fmhs,i-1);
              read(fmhs,rmhs);
              with rmhs do
              begin
              writeln('Nama Mahasiswa   : ',rmhs.nama);
              writeln('Nilai Mahasiswa  : ',rmhs.nilai:6:2);
              end;
           end;
        write('Yakin Data ini Akan di Hapus [Y/T] ? '); readln(ya);
        if upcase(ya) = 'Y' then
           begin
              seek(fmhs,nourut-1);
              truncate(fmhs);
           end;
     end;
     writeln;

     write('ada lagi yang akan dicari [Y/T] ? '); readln(lagi);
   end;
   close(fmhs);
end. 

Sekian artikel tentang Source Code Hapus Data dalam Pascal, semoga bermanfaat.

Source Code Edit Data dalam Pascal

Source Code Edit Data dalam Pascal - Edit data dalam suatu program tidak kalah pentingnya dalam mengoreksi data yang salah atau butuh perbaikan.

Berikut ini source code edit data menggunakan compiler dev-pascal :

program edit_data;
uses crt;
type
   mhs=record
      npm: string[7];
      nama: string[25];
      nilai: real;
   end;

var
   fmhs: file of mhs;
   rmhs: mhs;
   i,jml: integer;
   nocari: string[7];
   ketemu: boolean;
   lagi: char;

   begin
      assign(fmhs,'mhs.dat');
      reset(fmhs);

      jml:= filesize(fmhs);
      lagi:='Y';
      while upcase(lagi)='Y' do
      begin
         ketemu:= false;
         clrscr;
            write('Nomor Pokok Mahasiswa yang di Cari : '); readln(nocari);
            writeln;
            for i:= 1 to jml do
               begin
                  seek(fmhs,i-1);
                  read(fmhs,rmhs);
                     if rmhs.npm=nocari then
                        begin
                           with rmhs do
                           begin
                           ketemu:= true;
                           writeln('Nomor Pokok Mahasiswa  : ',npm:7);
                           write('Koreksinya             : '); readln(npm);
                           writeln('Nama Mahasiswa         : ',nama);
                           write('Koreksinya             : '); readln(nama);
                           writeln('Nilai Mahasiswa        : ',nilai:2:0);
                           write('Koreksinya             : '); readln(nilai);
                        end;
               end;
                  seek(fmhs,i-1);
                  write(fmhs,rmhs);
               end;
                     if not ketemu then
                        writeln('Tidak NPM Tersebut!!!');
                        writeln;
                        write('ada lagi yang akan dikoreksi [Y/T] ? ');
                        readln(lagi);
            end;
         close(fmhs);
      end. 

Selanjutnya berikut Program Hapus Data Mahasiswa dalam Pascal

Sekian artikel tentang Source Code Edit Data dalam Pascal, semoga bermanfaat.

Source Code Tambah Data dalam Pascal

Source Code Tambah Data dalam Pascal - Program berikut ini membahas tentang dasar untuk menambahkan data dalam pascal, biasanya database yang digunakan hanya berupa file berextrnsi .dat.

Berikut ini source code data mahasiswa dengan menggunakan compiler dev-pascal :

program tambah_data;
uses crt;
type
   mhs=record
      npm: string[7];
      nama: string[25];
      nilai: real;
   end;

var
   fmhs: file of mhs;
   rmhs: mhs;
   lagi: char;
begin
   assign(fmhs,'mhs.dat');
   {$I-}
   reset(fmhs);
   {$I+};
      if ioresult<>0 then rewrite(fmhs);
      seek(fmhs,filesize(fmhs));
   lagi:='y';
   while upcase(lagi)='Y' do
   begin
   clrscr;
      with rmhs do
      begin
         gotoxy(5,6)  ;write('Nomor Pokok Mahasiswa : ');
         gotoxy(5,8)  ;write('Nama Mahasiswa        : ');
         gotoxy(5,10) ;write('Nilai Mahasiswa       : ');
         gotoxy(30,6) ;readln(npm);
         gotoxy(30,8) ;readln(nama);
         gotoxy(30,10);readln(nilai);
      end;
   write(fmhs,rmhs);
   gotoxy(5,15) ;write('Masukan data lagi [Y/T] ? ');
   readln(lagi);
   end;
   close(fmhs);
end.

Source code di atas hanya berupa menambahkan data untuk menampilkan data lanjut ke Program Tampil Data Mahasiswa dalam Pascal.

assign(fmhs,'mhs.dat');

Tips untuk menyimpan Database

Terlebih dahulu buat lah file kosong dalam notepad yang berextensi mhs.dat

Sekian aartikel tentang Source Code Tambah Data dalam Pascal, semoga bermanfaat.

Source Code Tampil Data dalam Pascal

Source Code Tampil Data dalam Pascal - Program berikut ini lanjutan dari Program Tambah Data Mahasiswa dalam Pascal yang membahas tentang dasar untuk menampilkan data dalam pascal.

Biasanya data yang di panggil berupa database berbentuk file berextensi .dat.

Berikut ini source code tampil data menggunakan compiler dev-pascal :

program tampil_data;
uses crt;
type
   mhs=record
      npm: string[7];
      nama: string[25];
      nilai: real;
   end;

var
   fmhs: file of mhs;
   rmhs: mhs;

begin
   assign(fmhs,'mhs.dat');
   reset(fmhs);
   clrscr;
   writeln('-------------------------------------------------------------');
   writeln('NPM                    Nama Mahasiswa                   Nilai');
   writeln('-------------------------------------------------------------');
      while not eof (fmhs) do
      begin
         read(fmhs,rmhs);
         with rmhs do
            writeln(npm:7,nama:25,nilai:29:0);
      end;
   writeln('-------------------------------------------------------------');
   close(fmhs);
   readln;
end.

Untuk source code berikut :

assign(fmhs,'mhs.dat');

Source di atas merupakan code untuk mencari data file .dat yang sebelumnya digunakan untuk menyimpan data dalam Pascal, sebaiknya disimpan dalam satu folder dengan program.

Baca selanjutnya untuk Program Cari Data Mahasiswa dalam Pascal

Sekian artikel tentang Source Code Tampil Data dalam Pascal, semoga bermanfaat.

Source Code Matriks dalam Pascal

Source Code Matriks dalam Pascal - Penjumlahan matriks mengingatkan ane tentang matakuliah matematika informatika di semester awal.

Intinya dalam source code berikut membahas tentang penjumlahan 2 buah matriks dikatakan :

Matriks A + Matriks B = Matriks C

Untuk jumlah baris dan kolomnya bisa disesuaikan dengan keinginan.

Berikut ini source code matriks dalam pascal, menggunakan compiler dev-pascal :

program Jumlahatriks;

uses crt;

const
Jbaris = 2;
Jkolom = 3;

type
Matriks23 = array[1..Jbaris, 1..Jkolom] of integer;

var
A, B, C: Matriks23;
j, k: integer; {untuk indeks pengulangan}
begin
clrscr;

{mengisikan matriks A}
writeln('Matriks A');
for j:=1 to Jbaris do begin
for k:=1 to Jkolom do begin
write('A[', j, ',', k, '] = '); readln(A[j, k]);
end;
writeln;
end;
writeln;

{mengesikan matriks B}
writeln('matriks B');
for j:=1 to Jbaris do begin
for k:=1 to Jkolom do begin
write('B[', j, ',', k, '] = '); readln(B[j, k]);
end;
writeln;
end;
writeln;

{melakukan penjumlahan matriks A dan B sekaligus menampilkan hasilnya ke layar}
writeln('hasil penjumlahan');
for j:=1 to Jbaris do begin
for k:=1 to Jkolom do begin
C[j, k] := A[j,k] + B[j,k];
writeln('C[', j, ',', k, '] = ', C[j,k]);
end;
writeln;
end;

readln;
end.

Berikut hasil outputnya :

Sekian artikel tentang Source Code Matriks dalam Pascal, semoga bermanfaat.

Source Code Array dalam Pascal

Source Code Array dalam Pascal - Membuat source code array dalam pascal itu terbilang mudah hanya menggunakan kondisional for, dikombinasikan dengan batas array ingin dijangkau.

Pada source code berikut dieksekusi menggunakan compiler dev-pascal.

uses crt;
var
 a: array[1..5] of integer;
 i: integer;
begin
clrscr;
 for i:= 1 to 5 do
 begin
  a[i]:= i*1;
  writeln(a[i]);
 end;
 readln;
end.

Sekian artikel tentang Source Code Array dalam Pascal, semoga bermanfaat.

Project Akhir Sistem Informasi Koperasi Pascal

Project Akhir Sistem Informasi Koperasi Pascal - Project ini saya buat sehubungan dengan tugas akhir UAS mata kuliah Algoritma dan Pemrograman II.

Project ini udah jadul banget sebenernya :v, tapi akan berguna bagi mahasiswa baru yang lagi mempelajari pascal lalu di suruh membuat project :D, gimana :), langsung saja di liat programnya.

 Gambar Tampilan Awal Program Koperasi

Note : Jelas, login nya pun tidak memiliki SESSION :v, hanya sekedar login biasa.

Saya berserta kawan-kawan merancang aplikasi ini sekitar 3 bulan lebih, maklum ane masih newbie dan banyak suka dukanya waktu merancang program ini, soalnya sedikitnya referensi yang tersedia dan satu lagi media menyimpanan DATABASE aplikasi ini menggunakan notepad, langsung saja bila membutuhkan source aplikasi koperasi pascal ini.

Download Project Sistem Inforamsi Koperasi Pascal

Sekian project pascal tentang Project Akhir Sistem Informasi Koperasi Pascal, semoga bermanfaat.

Program Menghitung Tunjangan Karyawan Pascal

Program Menghitung Tunjangan Karyawan Pascal - Tunjangan Karyawan menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

uses crt;

var

jumlahanak,usia,tunjangan:integer;

begin

clrscr;

writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');

writeln('*Menghitung Tunjangan Karyawan*');

writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=');

write('Masukan Jumlah Anak = ');readln(jumlahanak);

write('Masukan Usia Anda   = ');readln(usia);

if (jumlahanak>3) then

begin

 if (usia<=30) then

  tunjangan:=400

 else

  tunjangan:=500;

end else if (jumlahanak<=3) then

begin

 if (usia<=30) then

  tunjangan:=350

 else

  tunjangan:=425;

end;

writeln('-------------------------------');

writeln('Tunjangan anda adalah = ',tunjangan);

readln;

end.

Berikut hasil output Program Tunjangan Karyawan yang dihasilkan.

Sekian program tentang Program Menghitung Tunjangan Karyawan Pascal, semoga bermanfaat.

Source Code Program Operasi String Pascal

Source Code Program Operasi String Pascal - Operasi String menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

program operasi_string_menghitung_dan_menampilkan_jumlah_kata;uses crt;



var jumkata,total,posisi: integer;

          kal,kata1,kata2: string;



PROCEDURE jumlah(kata: string; var JK: integer);

var x: integer;

begin

        if (kata[1]=' ') then JK:=0

        else JK:=1;

        for x:=1 to length(kata) do

        begin   if (kata[x]=' ') and (kata[x+1]<>' ') and (kata[x+2]<>' ') then inc(JK)

                else if (kata[x]='_') and (kata[x-1]<>' ') and (kata[x+1]<>' ') then inc(JK);

        end;

end;

begin

writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');

writeln('*Program Menghitung Jumlah Kata Dalam Kalimat*');

writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');

        writeln('');

        write('Masukan Kalimat : '); readln(kal);

        jumlah(kal,jumkata);

        writeln('=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-');

        writeln('Jumlah Kata dalam Kalimat di atas Sebanyak : ',jumkata,' buah');

        writeln;



total:=length(kal);

posisi:=pos(' ',kal);

kata1:=copy(kal,1,posisi);

kata2:=copy(kal,posisi+1,total);

writeln('Hasil Kata dari Kalimat di Atas adalah');

writeln('==============================================');

writeln('Kata Pertama              : ',kata1);

writeln('Kata Kedua & Seterusnya   : ',kata2);

        readln;

end.

Sekian program tentang Source Code Program Operasi String Pascal, semoga bermanfaat.

Source Code Program Luas Persegi dalam Pascal

Source Code Program Luas Persegi dalam Pascal - Luas Persegi menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

program luas_persegi; {heading program}

uses crt;

Var {bagian deklarasi}

    panjang,lebar :integer;

    luas          :real;

    o             :char;

begin {*bagian pernytaan*}

repeat

textbackground(78);

textcolor(87);

clrscr;

gotoxy(25,1);writeln('+================================+');

gotoxy(25,2);writeln('|Perogram Menghitung Luas Persegi|');

gotoxy(25,3);writeln('+================================+');

   write('Masukan Panjang : ');readln(panjang);

   write('Masukan Lebar : ');readln(lebar);

   luas :=panjang*lebar;

   write('luas Persegi Adalah : ');writeln(luas:8:2);

   write('Apakah Ingin Memasukan Lagi? (Y/N) = ');readln(o);

   until o = 'n';

    readln

end.

Berikut hasil output Program Luas Persegi yang dihasilkan.

Sekian program tentang Source Code Program Luas Persegi dalam Pascal, semoga bermanfaat.

Program Kondisional Jenis Kelamin Pascal

Program Kondisional Jenis Kelamin Pascal - Kondisional Jenis Kelamin menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

Program Kondisional;
uses crt;

var
jenis : char;
kelamin : string[20];
lagi : char;

begin
clrscr;
write('Masukan Jenis Kelamin L/P : ');readln(jenis);
if (jenis='L') or (jenis='l') then
kelamin:='Laki-Laki'
else
kelamin:='Perempuaan';
write('Jenis Kelamin Anda : ',kelamin);
readln;
end.

Berikut hasil output Program Kondisional Jenis Kelamin yang dihasilkan.

Sekian program tentang Program Kondisional Jenis Kelamin Pascal, semoga bermanfaat.

File Akses Pascal

File Akses Pascal - File Akses menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

program FileAkses;
uses crt;

type barang = record
  kode, nama : string;
  harga      : integer;
end;

var
  fileBarang : file of barang; //deklarasi
  dataBarang : barang;
  pil        : char;

procedure inputBarang;
var
ulangi : char;
begin
  assign(fileBarang,'barang.txt'); //memanggil
  {$i-}
  reset(fileBarang);               //membuka
  {$i+}
if ioresult<>0 then rewrite(fileBarang);
seek(fileBarang,filesize(fileBarang));  //memindahkan kursor
repeat
clrscr;
  writeln('-=-=-=-=-=-=-=-=-=-=');
  writeln('Program Input Barang');
  writeln('-=-=-=-=-=-=---=-=-=');
  write('Kode Barang  : ');readln(dataBarang.kode);
  write('Nama Barang  : ');readln(dataBarang.nama);
  write('Harga Barang : ');readln(dataBarang.harga);
  write(fileBarang,dataBarang); //simpan data
  writeln;
  write('Anda Ingin Input Barang Lagi (Y/T)');
repeat
ulangi:=readkey;
until (ulangi='y') or (ulangi='t');
until ulangi='t';
 close(fileBarang);
end;

procedure tampil;
var
x:integer;
begin
  assign(fileBarang,'barang.txt'); //memanggil
  {$i-}
  reset(fileBarang);               //membuka
  {$i+}
if ioresult<>0 then rewrite(fileBarang);
x:=0;
while not eof(fileBarang) do
begin
x:=x+1;
read(fileBarang,dataBarang); //membaca data
  writeln('-=-=-=-=-=-=-=-=-=-=-');
  writeln('Program Tampil Barang');
  writeln('-=-=-=-=-=-=---=-=-=-');
  writeln('Barang ke-',x);
  writeln('Kode   : ',dataBarang.kode);
  writeln('Nama   : ',dataBarang.nama);
  writeln('Harga  : ',dataBarang.harga);
end;
 close(fileBarang);
readln;
end;

//Program Utama
begin
repeat
clrscr;
  writeln('-=-=-=-=-=-=-=-=-=-=-=-');
  writeln('Program Database Barang');
  writeln('-=-=-=-=-=-=---=-=-=-=-');
  writeln('1. Input Barang');
  writeln('2. Tampil Barang');
  writeln('3. Keluar');
  writeln('*Input Pilihan ? (1/2/3)');
pil:=readkey;

case pil of
 '1' : inputBarang;
 '2' : tampil;
 '3' :

begin
writeln;
writeln('*Terimakasih Telah Menggunakan Program Kami*');
readln;
end;
 end;
until pil='3';
end.

Berikut hasil output Program File Akses Pascal yang dihasilkan.

Sekian program tentang File Akses Pascal, semoga bermanfaat.

Program Kumpulan Data Pascal

Program Kumpulan Data Pascal - Kumpulan Data menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

{*Program macam macam Data*}



var a,b:string;

q:char;

x,k,luas:real;

w,y,t,h,z,banyak,sisi,p,l:integer;



begin

writeln('-------------------');

writeln('       Menu        ');

writeln('-------------------');

writeln('1.Biodata');

writeln('2.Deret');

writeln('3.Luas Segitiga');

writeln('4.Keliling Bujur Sangkar');

writeln('5.Luas Bujur Sangkar');

writeln('-------------------');

writeln('Masukan Pilihan Anda : ');

readln(q);



case q of

'1':begin

write('Nama : ');readln(a);

write('NPM  : ');readln(b);

writeln(a);

writeln(b);

readln;

end;



'2':begin

write('Input Data : ');

readln(banyak);

for y := 1 to banyak do

begin

for z := 1 to y do

write(z);

writeln;

end;

readln;

end;



'3':begin

write('Input Alas : ');readln(t);

write('Input Tinggi : ');readln(h);

x := (t*h)/2;

writeln('Luas Segitiga : ',x:6:2);

readln;

end;



'4':begin

write('Input Sisi : ');readln(sisi);

k := (4*sisi);

writeln('Keliling Bujur Sangkar : ',k:6:2);

readln;

end;



'5':begin

write('Input Panjang : ');readln(p);

write('Input Lebar : ');readln(l);

luas := (p*l);

writeln('Luas Bujur Sangkar : ',luas:6:2);

readln;

end;

end;

end.

Berikut hasil output Program Kumpulan Data yang dihasilkan.

Sekian program tentang Program Kumpulan Data Pascal, semoga bermanfaat.

Program Penyewaan Buku Komik dalam Pascal

Program Penyewaan Buku Komik dalam Pascal - Penyewaan Buku Komik menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

    program persewaan_Komik;

    {jangan lupa titik koma dan nama file tidak boleh pakai space}

    

    {library yang digunakan}

    uses crt, dos; {mengatur tampilan}

    

    {deklarasi record transaksi}

    type

    transaksi = record

     nama:string;

     nim:real;

     kodeBuku:integer;

     dP:word;

     mP:word;

     yP:word;

     dK:word;

     mK:word;

     yK:word;

     status:string;

    end;

    

    {deklarasi record buku komik}

     buku = record

     kodeBuku:integer;

     edisi:string;

     judul:string;

     tahun:integer;

     hargaSewa:integer;

     stok:integer;

    end;

    

    {deklarasi array}

    dataPelanggan = array [1..20] of transaksi;

    dataBuku = array[1..20] of buku;

    

    {dekarasi variable global}

    var

     p:dataPelanggan;

     b:dataBuku;

     lastBuku:integer;

     lastTransaksi:integer;

     indexBuku:integer;

     pilih:integer;

     i:integer;

    

    {daftar koleksi buku default}

    procedure daftarKomik();

    begin

     b[1].judul := 'Naruto Shipudden';

     b[1].kodeBuku := 310;

     b[1].tahun := 2011;

     b[1].edisi := '1-5';

     b[1].hargaSewa:=1000;

     b[1].stok:=1;

    

    b[2].judul := 'Samurai X';

     b[2].kodeBuku := 311;

     b[2].tahun := 2012;

     b[2].edisi := '6-10';

     b[2].hargaSewa:=1500;

     b[2].stok:=1;

    

    b[3].judul := 'Doremon';

     b[3].kodeBuku := 312;

     b[3].tahun := 2012;

     b[3].edisi := '11-20';

     b[3].hargaSewa:=1000;

     b[3].stok:=2;

    

    b[4].judul := 'fireTail';

     b[4].kodeBuku := 313;

     b[4].tahun := 2011;

     b[4].edisi := '51-60';

     b[4].hargaSewa:=1500;

     b[4].stok:=1;

    

    b[5].judul := 'Dragon Ball Z';

     b[5].kodeBuku := 314;

     b[5].tahun := 2012;

     b[5].edisi := '61-70';

     b[5].hargaSewa:=1000;

     b[5].stok:=2;

    

     b[6].judul := 'EX-men';

     b[6].kodeBuku := 315;

     b[6].tahun := 2012;

     b[6].edisi := '71-80';

     b[6].hargaSewa:=1000;

     b[6].stok:=1;

    

    b[7].judul := 'Kapten Stubasa';

     b[7].kodeBuku := 316;

     b[7].tahun := 2010;

     b[7].edisi := '41-60';

     b[7].hargaSewa:=2000;

     b[7].stok:=0;

    

    b[8].judul := 'Betmen';

     b[8].kodeBuku := 317;

     b[8].tahun := 2010;

     b[8].edisi := '61-80';

     b[8].hargaSewa:=1500;

     b[8].stok:=1;

    

    b[9].judul := 'One Piace';

     b[9].kodeBuku := 318;

     b[9].tahun := 2011;

     b[9].edisi := '90-100';



     b[9].hargaSewa:=2000;



     b[9].stok:=1;



    



    b[10].judul := 'Ben 10';

     b[10].kodeBuku := 319;

     b[10].tahun := 2011;

     b[10].edisi := '101-110';

     b[10].hargaSewa:=1000;

     b[10].stok:=2;

    end;

    

{daftar transaksi pelanggan dafault}

procedure daftarPelanggan();

begin

 p[1].nama:='Ariska';

 p[1].nim:=10030092;

 p[1].kodeBuku:=311;

 p[1].dP:=13;

 p[1].mP:=4;

 p[1].yP:=2012;

 p[1].dK:=16;

 p[1].mK:=4;

 p[1].yK:=2012;

 p[1].status:='Sdh Dikembalikn';

    

 p[2].nama:='Ahmad';

 p[2].nim:=10080023;

 p[2].kodeBuku:=313;

 p[2].dP:=16;

 p[2].mP:=4;

 p[2].yP:=2012;

 p[2].dK:=19;

 p[2].mK:=4;

 p[2].yK:=2012;

 p[2].status:='Sdh Dikembalikn';



 p[3].nama:='Imam Mahdi';

 p[3].nim:=10080011;

 p[3].kodeBuku:=314;

 p[3].dP:=18;

 p[3].mP:=4;

 p[3].yP:=2012;

 p[3].dK:=21;

 p[3].mK:=4;

 p[3].yK:=2012;

 p[3].status:='Blm Dikembalikn';



 p[4].nama:='Hanifah';

 p[4].nim:=10080001;

 p[4].kodeBuku:=319;

 p[4].dP:=24;

 p[4].mP:=4;

 p[4].yP:=2012;

 p[4].dK:=27;

 p[4].mK:=4;

 p[4].yK:=2012;

 p[4].status:='Blm Dikembalikn';



 p[5].nama:='Bambang';

 p[5].nim:=10080099;

 p[5].kodeBuku:=316;

 p[5].dP:=23;

 p[5].mP:=4;

 p[5].yP:=2012;

 p[5].dK:=26;

 p[5].mK:=04;

 p[5].yK:=2012;

 p[5].status:='Blm Dikembalikn';



 p[6].nama:='Muttaqin';

 p[6].nim:=10030021;

 p[6].kodeBuku:=315;

 p[6].dP:=25;

 p[6].mP:=4;

 p[6].yP:=2012;

 p[6].dK:=28;

 p[6].mK:=04;

 p[6].yK:=2012;

 p[6].status:='Blm Dikembalikn';

    

 p[7].nama:='Suryan';

 p[7].nim:=10030004;

 p[7].kodeBuku:=312;

 p[7].dP:=26;

 p[7].mP:=4;

 p[7].yP:=2012;

 p[7].dK:=29;

 p[7].mK:=04;

 p[7].yK:=2012;

 p[7].status:='Blm Dikembalikn';

end;



{input data transaksi}

procedure inputTransaksi();

var

 nama:string;

 nim:real;

 y,m,d,hari:word;

 yK,mK,dK:word;

 jumlah:integer;

 kodeBuku:integer;

 ulangi, ketemu, pernahPinjam : Boolean;

 n:integer;



begin

 getdate(y,m,d,hari); {input tanggal hari ini}

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Transaksi Peminjaman Komik ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln();

 write(' Masukkan nama : '); readln(nama);

 write(' NIM : '); readln(nim);

 writeln();

 writeln(' Tanggal pinjam : ',d,'/',m,'/',y);

 dK:= d + 3; {batas pinjam cuma tiga hari}



 if dk >= 30 then {jika pinjam di akhir bulan}

 begin

 dk := dk-30+1;

 mK := m+1;

 end;



 yK := y;{ tahun peminjaman dan tahun sekarang sama}

 writeln(' Tanggal kembali: ',dK,'/',mK,'/',yK);

 writeln();

 write('Berapa banyak buku yang dipinjam : ');readln(jumlah);

 writeln();



 {Buku - buku yang akan dipijam}

 for i:= 1 to jumlah do

 begin

 repeat

 ulangi := false;

 ketemu := false;

 pernahPinjam:= false;

 {Input kode buku}

 write(i,'. Kode buku : ');readln(kodeBuku);



 {mengecek apakah buku pernah dipijam}

 for n:= 1 to (lastTransaksi-1) do

 begin

 if p[n].nim = nim then

 begin

 if p[n].kodeBuku = kodeBuku then

 begin

 pernahPinjam := true;

 end

 end

 end;



 {mengecek apakah buku yang dipinjam ada}

     for n:= 1 to (lastBuku-1) do

 begin

 if (b[n].kodeBuku = kodeBuku) and (b[n].stok <> 0) then

 begin

 p[lastTransaksi].kodeBuku := kodeBuku;

 b[n].stok := b[n].stok - 1;

 ketemu := true;

 end

 end;



 {jika buku tidak ada di data base atau stok buku habis}

 if ketemu <> true then

 begin

 ulangi := true;

 writeln(' Kode Buku Tidak Dikenali atau Stok Habis!! ');

 writeln();

 end;



 {jika sebelumnya pernah transaksi buku}

 if pernahPinjam = true then

 begin

 ulangi := true;

 writeln(' Pelanggan Pernah Pinjam Sebelumnya!!');

 writeln();

 end;

 until ulangi = false;



 {penyalinan nama, nim, tanggal pinjam dan tanggal ke database transaksi}

 p[lastTransaksi].nama := nama;

 p[lastTransaksi].nim := nim;

 p[lastTransaksi].dP:=d;

 p[lastTransaksi].mP:=m;

 p[lastTransaksi].yP:=y;

 p[lastTransaksi].dK:=dK;

 p[lastTransaksi].mK:=mK;

 p[lastTransaksi].yK:=yK;

 p[lastTransaksi].status:='Blm Dikembalikn';

 lastTransaksi := lastTransaksi + 1;

 end;

 writeln();

 writeln(' Transaksi Berhasil!! ');

 writeln();

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

end;



{tampilkan data}

procedure tampilkanData();

var

 {variable local}

 pilih2:integer;

 baris:integer;



begin

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Data yang Akan Dilihat ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' 1. Persediaan Buku');

 writeln(' 2. Daftar Transaksi Pelanggan');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 write(' Pilih[1/2]: '); readln(pilih2);



 {jika yang dipiliha adalah persediaan buku}

 if pilih2 = 1 then

 begin

 clrscr;

 writeln(' Daftar Semua Buku');

 writeln('+---------------------------------------------------------------+');

 writeln('| Kode Buku | Judul Buku | Edisi | Tahun | harga sewa | stok |');

 writeln('+---------------------------------------------------------------+');



 {mencetak semua data yang ada di database koleksi buku}

 for i:= 1 to (lastBuku-1) do

 begin

 write('| ',b[i].kodeBuku);

 write('| ',b[i].judul);

 write('| ',b[i].edisi);

 write('| ',b[i].tahun);

 writeln('| ',b[i].hargaSewa);

 writeln('| ',b[i].stok);

 writeln('|');

 baris := baris+1;

 end;

 writeln('+---------------------------------------------------------------+');

 {jika tidak memilih 1 }

 end else

 begin

 clrscr;

 writeln(' Daftar Semua Transaksi ');

 writeln('+-----------------------------------------------------------------------------+');

 writeln('| Nim | Nama | K. Buku | Tgl Pinjam | Tgl Kembali | Status |');

 writeln('+-----------------------------------------------------------------------------+');

 {mencetak semua data uang ada di database transaksi}

 for i:= 1 to (lastTransaksi-1) do

 begin

 gotoxy(1,baris); write('| ',p[i].nim:0:0);

 gotoxy(12,baris); write('| ',p[i].nama);

 gotoxy(24,baris);write('| ',p[i].kodeBuku);

 gotoxy(34,baris);write('| ',p[i].dP,'/',p[i].mP,'/',p[i].yP);

 gotoxy(47,baris);write('| ',p[i].dK,'/',p[i].mK,'/',p[i].yK);

 gotoxy(61,baris);write('| ',p[i].status);

 gotoxy(79,baris);writeln('|');

 baris := baris+1;

 end;

 writeln('+-----------------------------------------------------------------------------+');

 end;

 end;



{pemgembalian buku}

procedure pengembalianBuku();

var

 pilih2:integer;

 nim:real;

 nama:string;

 indexTemu:integer;

 ketemu:Boolean;

 temu:array[1..20] of integer;

 baris:integer;

 n:integer;

 kembalikan:integer;

 hari:integer;

 d,m,y, dow:word;

 bayar, denda:real;

 totalBayar:real;



begin

 getDate(y,m,d,dow); {input tanggal sekarang}

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Pengembalian Buku');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Pencarian berdasarkan :');

 writeln(' 1. NIM ');

 writeln(' 2. Nama ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 write(' Pilih [1/2]: ');readln(pilih2);

 writeln();



 {jika memilih nim}

 if pilih2 = 1 then

 begin

 write(' Masukkan Nim : ');readln(nim);



 {mengecek di databese transaksi apakah ada nim tersebut}

 for i:= 1 to (lastTransaksi-1) do

 begin

    

     {jika ada}

     if p[i].nim = nim then

     begin

     ketemu:= true;

     temu[indexTemu]:=i;

     nama:=p[i].nama;

     indexTemu:= indexTemu + 1;

     end

    

     end;

    

     end else

     begin

     write(' Masukkan Nama : ');readln(nama);

     {mengecek apakah nama tersebut ada di database transaksi}

     for i:= 1 to (lastTransaksi-1) do

     begin

    

     {jika ada}

     if p[i].nama = nama then

     begin

     ketemu:= true;

     temu[indexTemu]:=i;

     nama:=p[i].nama;

     indexTemu:= indexTemu + 1;

     end

    

     end;

    

     end;

    

     if ketemu = true then

     begin

     {proses(index);}

     clrscr;

     writeln(' Pengembalian Buku (',nama,')');

     writeln('+---------------------------------------------------------------------+');

     writeln('| No. | Kode Buku | Judul Buku | Tgl Kembali | Status |');

     writeln('+---------------------------------------------------------------------+');

    

     {menampilkan semua data yang pernah dipinjam oleh pelanggan}

     for i:= 1 to (indexTemu-1) do

     begin

     write('| ',i);

     write('| ',p[temu[i]].kodeBuku);

    

     {melakukan relasi ke databese buku}

     for n:= 1 to (lastBuku-1) do

     begin

     if b[n].kodeBuku = p[temu[i]].kodeBuku then

     begin

     write('| ',b[n].judul);

     end

    

     end;

    

     write('| ',p[temu[i]].dK,'/',p[temu[i]].mK,'/',p[temu[i]].yK);

     write('| ',p[temu[i]].status);

     writeln('|');

     baris := baris+1;

     end;

    

     writeln('+---------------------------------------------------------------------+');

     writeln('| Pilih 0 untuk Keluar |');

     writeln('+---------------------------------------------------------------------+');

    

     {melakukan perlangan jika tidak menekan nol atau angka yang tidak sesuai}

     repeat

     write('Pilih daftar no. yang akan dikembalikan : ');readln(kembalikan);

     writeln();

     hari := 0;

     denda := 0;

     bayar := 0;

    

     {jika pelnaggan nekan nol atau melebihi angka yang ditentukan}

     if (kembalikan <> 0) and (kembalikan <indexTemu) then

     begin

    

     {jika buku tersebut belum dikembalikan}

     if p[temu[kembalikan]].status <> 'Sdh Dikembalikn' then

     begin

     {menghitung denda}

     hari:= 0;

    

     {mengecek apakah bulan dan tahun sama}

     if (m = p[temu[kembalikan]].mK) and (y = p[temu[kembalikan]].yK) then

     begin

     hari := d - p[temu[kembalikan]].dK;{jarak hari}

     {mengecek apakah tahun pinjam dan tahun sekarang sama}

     end else if (m <> p[temu[kembalikan]].mK) and (y = p[temu[kembalikan]].yK) then

     begin

     hari := (m - p[temu[kembalikan]].mK)*30; { jarak bulan}

     hari := hari - p[temu[kembalikan]].dK - (30 - d); {jarak bulan - jarak hari}

     end;

    

     {jika mengembalikan sebelum hari ditentukan}

     if hari<0 then

     begin

     hari := 0;

     end;

     denda := hari * 1000;

     writeln(' Terlambat : ',hari,' Hari');

    

     {mencari harga yang ada di database buku}

     for i:= 1 to (lastBuku-1) do

     begin

    

     {jika kode buku sama}

     if p[temu[kembalikan]].kodeBuku = b[i].kodeBuku then

     begin

     bayar:= b[i].hargaSewa+denda;

     b[i].stok := b[i].stok + 1 ;

     writeln(' Harga Sewa : Rp ',b[i].hargaSewa,',00');

     writeln(' Denda : Rp ',denda:0:0,',00');

     writeln(' Jumlah : Rp ',bayar:0:0,',00');

     totalBayar := totalbayar + bayar;

     end

     end;

    

     {menyesuaikan status dan tanggal kembali}

     p[temu[kembalikan]].status:= 'Sdh Dikembalikn';

     p[temu[kembalikan]].dK:=d;

     p[temu[kembalikan]].mK:=m;

     p[temu[kembalikan]].yK:=y;

    

     writeln();

     writeln(' Total Sementara adalah : Rp ',totalBayar:0:0,',00');

     writeln();

     end else

     begin

     writeln(' Buku sudah DiKembalikan!!');

     writeln();

     end;

     {jika menekan nol dan menekan angka yang tidak sesuai}

     end else

     begin

     kembalikan := 0;

     end;

     until kembalikan = 0;

     {jika nim atau nama tidak terdapat di databese transaksi}

     end else

     begin

     writeln(' Maaf, data tidak ditemukan!!');

     writeln();

     end;

     writeln();

     writeln(' Jadi, Total yang harus dibayar adalah : Rp ',totalBayar:0:0,',00');

     writeln();

    end;

    

    {hapus data}

    procedure hapusData();

    var

     n:integer;

     baris:integer;

     hapus:integer;

    

    begin

     {melakukan perulangan selama tidak menekan 0}

     repeat

     baris:= 5;

     clrscr;

     writeln(' Daftar Semua Transaksi ');

     writeln('+--------------------------------------------------------------------------+');

     writeln('| No.| NIM | Nama | Judul buku yang dipinjam | Status |');

     writeln('+--------------------------------------------------------------------------+');

    

     {menampilkan semua data yang ada di transaksi data}

     for i:= 1 to (lastTransaksi-1) do

     begin

     gotoxy(1,baris); write('| ',i);

     gotoxy(6,baris); write('| ',p[i].nim:0:0);

     gotoxy(18,baris); write('| ',p[i].nama);

    

     {melakukan relasi untuk mencari nama buku}

     for n:= 1 to (lastBuku-1) do

     begin

     if p[i].kodeBuku = b[n].kodeBuku then

     begin

     gotoxy(31,baris);write('| ',b[n].judul);

     end;

     end;

     gotoxy(58,baris);write('| ',p[i].status);

     gotoxy(76,baris);writeln('|');

     baris := baris+1;

     end;

     writeln('+--------------------------------------------------------------------------+');

     writeln('| Pilih 0 untuk Batalkan Pengahapusan |');

     writeln('+--------------------------------------------------------------------------+');

     write(' Pilih No transaksi yang akan dihapus : ');readln(hapus);

    

     {jika tidak menekan nol}

     if hapus<>0 then

     begin

    

     {menumpuk data yang akan dihapus dengan data sebelumnya}

     for i:= hapus to (lastTransaksi-2) do

     begin

     p[i].nama:=p[i+1].nama;

     p[i].nim:=p[i+1].nim;

     p[i].kodeBuku:=p[i+1].kodeBuku;

     p[i].dP:=p[i+1].dP;

     p[i].mP:=p[i+1].mP;

     p[i].yP:=p[i+1].yP;

     p[i].dK:=p[i+1].dK;

     p[i].mK:=p[i+1].mK;

     p[i].yK:=p[i+1].yK;

     p[i].status:=p[i+1].status;

     end;

    

     lastTransaksi := lastTransaksi - 1;

     writeln();

     writeln(' Hapus Data Transaksi Berhasil!!');

     writeln();

     end;

    

     until hapus = 0;

    end;

    

    {untuk menambah daftar buku}

    procedure tambahBuku();

    var

     {variable local}

     tambah:integer;

    

    begin

     writeln();

     writeln(' Tambah Buku');

     writeln();

     write(' Berapa Buku yang akan ditambah: ');readln(tambah);

    

     {melakukan perulangan sebanyak jumlah yang ditambahkan}

     for i:= 1 to tambah do

     begin

     writeln();

     writeln(' No. ',i);

     writeln(' Kode Buku : ',indexBuku);

     b[lastBuku].kodeBuku:=indexBuku;

     indexBuku:= indexBuku + 1;

     write(' Judul Buku : ');readln(b[lastBuku].judul);

     write(' Edisi : ');readln(b[lastBuku].edisi);

     write(' Tahun : ');readln(b[lastBuku].tahun);

     write(' Harga Sewa : ');readln(b[lastBuku].hargaSewa);

     write(' Stok : ');readln(b[lastBuku].stok);

     lastBuku := lastBuku+1;

     end;

     writeln();

     writeln(' Tambah Buku Berhasil!!');

     writeln();

     writeln('tekan enter untuk melanjutkan...');

    end;

    

    {melakukan pembaruan harga dan stok buku}

    procedure updateBuku();

    var

     {variable local}

     baris:integer;

     index:integer;

    

    begin

     repeat

     baris:=5;

     clrscr;

     writeln(' Update Harga dan stok Buku ');

     writeln('+---------------------------------------------------+');

     writeln('| no. Buku | Judul Buku | harga sewa | stok |');

     writeln('+---------------------------------------------------+');

    

     {menampilkan semua daftar buku}

     for i:= 1 to (lastBuku-1) do

     begin

     gotoxy(1,baris);write('| ',i);

     gotoxy(12,baris);write('| ',b[i].judul);

     gotoxy(32,baris);write('| ',b[i].hargaSewa);

     gotoxy(45,baris);write('| ',b[i].stok);

     gotoxy(53,baris);writeln('|');

     baris := baris+1;

     end;

    

     writeln('+---------------------------------------------------+');

     writeln('| Pilih 0 untuk membatalkan |');

     writeln('+---------------------------------------------------+');

     write(' Masukkan no. Buku : ');readln(index);

    

     {jika tidak menekan nol}

     if index <> 0 then

     begin

     writeln(' Judul Buku : ',b[index].judul);

     writeln(' Harga Sewa Semula : ',b[index].hargaSewa);

     write(' Harga Sewa Baru : ');readln(b[index].hargaSewa);

     writeln(' Stok Semula : ',b[index].stok);

     write(' Stok Baru : ');readln(b[index].stok);

     writeln();

     writeln(' Update Berhasil!!');

     writeln();

     end else

     begin

     writeln();

     writeln(' Update Selesai!!');

     writeln();

     end;

    

     writeln('tekan enter untuk melanjutkan...');

     until index=0;

    end;

    

    procedure hapusBuku();

    var

     {variable local}

     baris:integer;

     hapus:integer;

    

    begin

     repeat

     baris:=5;

     clrscr;

     writeln(' Hapus Buku ');

     writeln('+-------------------------------------+');

     writeln('| No. | Kode Buku | Judul Buku |');

     writeln('+-------------------------------------+');

    

     {menampilkan semua daftar buku}

     for i:= 1 to (lastBuku-1) do

     begin

 gotoxy(1,baris);write('| ',i);

 gotoxy(7,baris);write('| ',b[i].kodeBuku);

 gotoxy(19,baris);write('| ',b[i].judul);

 gotoxy(39,baris);writeln('|');

 baris := baris+1;

 end;



 writeln('+-------------------------------------+');

 writeln('| Tekan 0 untuk membatalkan |');

 writeln('+-------------------------------------+');

 write(' No. Buku yang akan dihapus : ');readln(hapus);



 {jika tidak menekan nol}

 if hapus <> 0 then

 begin

 {menimpa daftar lama dengan daftar baru}

 for i:= hapus to (lastBuku-2) do

 begin

 b[i].kodeBuku := b[i+1].kodeBuku ;

 b[i].judul:= b[i+1].judul;

 b[i].edisi := b[i+1].edisi;

 b[i].tahun:= b[i+1].tahun;

 b[i].hargaSewa := b[i+1].hargaSewa;

 b[i].stok := b[i+1].stok;

 end;

 lastBuku := lastBuku-1;

 writeln();

 writeln(' Hapus Berhasil!!');

 writeln();

 end else

 begin

 writeln();

 writeln(' Hapus Selesai!!');

 writeln();

 end;

 writeln('tekan enter untuk melanjutkan...');

 until hapus=0;

end;



{menampilkan semua daftar koleksi buku}

procedure lihatBuku();

var

 baris:integer;

begin

 clrscr;

 writeln(' Daftar Buku');

 writeln('+---------------------------------------------------------------+');

 writeln('| Kode Buku | Judul Buku | Edisi | Tahun | harga sewa | stok |');

 writeln('+---------------------------------------------------------------+');

 for i:= 1 to (lastBuku-1) do

 begin

 gotoxy(1,baris);write('| ',b[i].kodeBuku);

 gotoxy(13,baris);write('| ',b[i].judul);

 gotoxy(27,baris);write('| ',b[i].edisi);

 gotoxy(37,baris);write('| ',b[i].tahun);

 gotoxy(45,baris);writeln('| ',b[i].hargaSewa);

 gotoxy(58,baris);writeln('| ',b[i].stok);

 gotoxy(65,baris);writeln('|');

 baris := baris+1;

 end;

 writeln('+---------------------------------------------------------------+');

 writeln('tekan enter untuk melanjutkan...');

end;



{edit buku}

procedure editBuku();

var

 pilih3:integer;



begin

 repeat

 clrscr;

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Edit Daftar Buku ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' 1. Tambah Koleksi Buku ');

 writeln(' 2. update harga dan stok Buku ');

 writeln(' 3. Hapus Buku');

 writeln(' 4. Lihat daftar Buku ');

 writeln(' 5. Kembali Ke Memu Utama ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 write('Pilih [1-5]: ');readln(pilih3);

 case pilih3 of

 1:

 begin

 tambahBuku();

 readln;

 end;

 2:

 begin

 updateBuku();

 readln;

 end;

 3:

 begin

 hapusBuku();

 readln;

 end;

 4:

 begin

 lihatBuku();

 readln;

 end;

 5:

 end;

 until pilih3 = 5;

end;



{keluar}

procedure keluar();

begin

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Sekian dan trimakasih');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Aplikasi ini disusun oleh :');

 writeln(' 1. Ariska Hidayat (10030092)');

 writeln(' 2. Muttaqin (10030021)');

 writeln(' 3. Suryan Dwi Saputro(10030004)');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

    end;



{ ke menu utama aplikasi}

procedure menu();

begin

 writeln();

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' Persewaan Buku Komik Terlengkap');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 writeln(' 1. Transaksi peminjaman ');

 writeln(' 2. Tampilkan Data ');

 writeln(' 3. Pengembalian Buku ');

 writeln(' 4. Hapus data Peminjam ');

 writeln(' 5. Edit koleksi komik');

 writeln(' 6. Keluar ');

 writeln('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');

 write(' Pilih[1-6]: '); readln(pilih);

 writeln();

 case pilih of

 1:

 inputTransaksi();

 2:

 tampilkanData();

 3:

 pengembalianBuku();

 4:

 hapusData();

 5:

 editBuku();

 6:

 keluar();

 end;

end;



{main}

begin

 daftarKomik();

 daftarPelanggan();

 repeat

 clrscr;

 menu();

 writeln('tekan enter untuk melanjutkan...');

 readln;

 until pilih = 6; {berhenti jika pilih bernilai 6}

end.

Sekian program tentang Program Penyewaan Buku Komik dalam Pascal, semoga bermanfaat.

Source Code Program Kalkulator dalam Pascal

Source dalam Pascal Code Program Kalkulator - Kalkulator menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

{*Program Kalkulator*}

uses crt;
var bil1,bil2,hasil:real;
i,r:char;

begin
repeat
textbackground(1);
textcolor(2);
clrscr;
writeln('Kalkulator Canggih Unsika');
writeln('------------------------------------------------------------------');
write('Input Bilangan Pertama = ');
readln(bil1);
write('Operasi Perhitungan = ');
readln(i);
write('Input Bilangan Kedua = ');
readln(bil2);

case i of
'+':hasil:=bil1+bil2;
'-':hasil:=bil1-bil2;
'*':hasil:=bil1*bil2;
'/':hasil:=bil1/bil2;
end;

writeln('==================================================================');
writeln('Hasil Perhitungan = ',hasil:6:2);
write('Hitung Lagi? (yes/no) = ');readln(r);
until r='n';
readkey;
end.

Berikut hasil output Program Kalkulator yang dihasilkan.

Sekian program tentang Source Code Program Kalkulator dalam Pascal, semoga bermanfaat.

Source Code Program Database Pascal

Source Code Program Database Pascal - Database Pascal menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

uses crt ;

type Produk = Record

     Kode  : String[3] ;

     Nama  : String[30] ;

     Harga : Longint ;

     End;

Var

   fPro : File of Produk ;

   ftemp: File of Produk ;

   rPro : Produk ;

   lg   : Char ;

   i    : byte ;

   xkode: string[8] ;

   ketemu: boolean  ;

   pil   : byte ;



procedure openproduk ;

begin

     Assign(fpro, 'produk.dat') ;

     {$I-} Reset(fpro) ;

     {$I+}if IOResult<>0 then Rewrite(fpro) ;

end;



procedure inputproduk ;

begin

     OpenProduk ;

     Repeat

           clrscr;

           GotoXY(40,5) ; Write('Input Data Produk')  ;

           GotoXY(40,6) ; Write('-----------------------------')  ;

           GotoXY(40,7) ; Write('Kode  : ')  ; Readln(rpro.Kode) ;

           xkode :=rpro.Kode;

           i := 1;

           seek(fpro,0) ; ketemu := false ;

           while not eof(fpro) do

           begin

               seek(fpro,i-1); read (fpro, rpro) ;

               if rpro.kode = xkode then

               begin

                    ketemu := true ;

                    GotoXY(40,8) ; Write('Nama  : ',rpro.Nama) ;

                    GotoXY(40,9) ; Write('Harga : ',rpro.Harga);

                    GotoXY(40,10); Write('-----------------------------')  ;

                    GotoXY(40,11); Write('Data Sudah Ada')  ;

               end;

               inc(i);

           end;



           if not ketemu then

           begin

                rpro.Kode := xkode ;

                GotoXY(40,8) ; Write('Nama  : ')  ; Readln(rpro.Nama) ;

                GotoXY(40,9) ; Write('Harga : ')  ; Readln(rpro.Harga) ;

                GotoXY(40,10); Write('-----------------------------')  ;

                Seek(fpro, Filesize(fpro)) ;

                write(fPro, rpro) ;

           end;

           GotoXY(40,12); Write('Input Lagi [Y/T] : ')  ; Readln(lg) ;

     Until Upcase(Lg)='T' ;

     close(fPro) ;

end;



procedure hapusproduk ;

begin

     Assign(ftemp, 'temp.dat') ;

     {$I-} Reset(ftemp) ;

     {$I+} if ioresult<>0 then Rewrite(ftemp) ;

     OpenProduk ;



     Rewrite(ftemp) ;

     Repeat

           GotoXY(40,5) ; Write('Input Data Produk yang dihapus');

           GotoXY(40,6) ; Write('-----------------------------') ;

           GotoXY(40,7) ; Write('Kode  : ')  ; Readln(rpro.Kode) ;

           xkode :=rpro.Kode;

           i := 1;

           seek(fpro,0) ; ketemu := false ;

           while not eof(fpro) do

           begin

               seek(fpro,i-1); read (fpro, rpro) ;

               if rpro.kode = xkode then

               begin

                    ketemu := true ;

               end

               else

               begin

                    seek(ftemp,filesize(ftemp));

                    write(ftemp,rpro) ;

               end;

               inc(i);

           end;

           i := 1;

           rewrite(fpro) ;

           seek(ftemp,0) ;

           while not eof(ftemp) do

           begin

               seek(ftemp,i-1); read (ftemp, rpro) ;



               seek(fpro,filesize(fpro));

               write(fpro,rpro) ;

               inc(i);

           end;



           if not ketemu then

           begin

                GotoXY(40,8) ; Write('Data ini tidak ada')

           end

           else

           begin

                GotoXY(40,8) ; Write('Data ini sudah di hapus')

           end;

           GotoXY(40,12); Write('Input Lagi [Y/T] : ')  ; Readln(lg) ;

     Until Upcase(Lg)='T' ;

     close(ftemp) ;

     close(fPro) ;

end;





procedure outputProduk;

begin

     OpenProduk ;

     i :=1 ;

     Gotoxy(30, 4) ; Write('Informasi PRODUK') ;

     Gotoxy(30, 5) ; Write('-----------------------------------------') ;

     Gotoxy(30, 6) ; Write(' No  Kode   Nama                Harga    ') ;

     Gotoxy(30, 7) ; Write('-----------------------------------------') ;
     seek(fpro, 0) ;

     while not eof(fpro) do

     begin

        seek(fpro, i-1) ;

        read(fpro, rpro) ;

        Gotoxy(32, 7+i) ; Write( i ) ;

        Gotoxy(35, 7+i) ; Write( rpro.Kode ) ;

        Gotoxy(42, 7+i) ; Write( rpro.Nama)  ;

        Gotoxy(60, 7+i) ; Write( rpro.Harga:9) ;

        inc (i) ;

     end;

     Gotoxy(30, 7+i) ; Write('-----------------------------------------') ;

     Gotoxy(30, 8+i) ; Write('press any key to continue...') ;

     Close(fPro) ;

     Repeat Until Keypressed;

end;



procedure menu ;

begin

     clrscr ;

     Gotoxy(2, 3) ; Write('------------------------') ;

     Gotoxy(2, 4) ; Write(' Menu Utama') ;

     Gotoxy(2, 5) ; Write('------------------------') ;

     Gotoxy(2, 6) ; Write(' 1. Input Produk') ;

     Gotoxy(2, 7) ; Write(' 2. Hapus Produk') ;

     Gotoxy(2, 8) ; Write(' 3. Informasi Produk') ;

     Gotoxy(2, 9) ; Write(' 4. Keluar') ;

     Gotoxy(2,10) ; Write('------------------------') ;

     Gotoxy(2,11) ; Write(' Pilihan : ') ; readln(pil);

end;



begin

     pil := 0 ;

     while pil<>4 do

     begin

          menu ;

          case pil of

               1 : inputproduk ;

               2 : hapusproduk ;

               3 : outputproduk ;

          end;

     end;

end.

Berikut hasil output Program Database Pascal yang dihasilkan.

Database akan otomastis di buat dengan nama Produk.dat saat kita memilih menu Informasi Produk, walaupun program telah di close namun data yang telah di input tetap tersimpan.

Sekian program tentang Source Code Program Database Pascal, semoga bermanfaat.

Source Code Program Data Mahasiswa dengan Record dalam Pascal

Source Code Program Data Mahasiswa dengan Record dalam Pascal - Data Mahasiswa dengan Record menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

uses crt;
type mahasiswa=record
        nama: string;
        npm: string;
        jenis_kelamin: string;
end;
var siswa: mahasiswa;
begin
clrscr;
writeln('Data Mahasiswa');
writeln('------------------------------------------------------------------');
write('Masukan Nama : ');readln(siswa.nama);
write('Masukan NPM : ');readln(siswa.npm);
write('Masukan Jenis Kelamin : ');readln(siswa.jenis_kelamin);writeln;
writeln(siswa.nama);
writeln(siswa.npm);
writeln(siswa.jenis_kelamin);
readln;
end.

Berikut hasil output Program Data Mahasiswa dengan Record yang dihasilkan.

Sekian program tentang Source Code Program Data Mahasiswa dengan Record dalam Pascal, semoga bermanfaat.

Source Code Program Menghitung Nilai Mahasiswa dalam Pascal

Source Code Program Menghitung Nilai Mahasiswa dalam Pascal - Menghitung Nilai Mahasiswa menggunakan kompiler Dev-Pascal, berikut ini Source Code Program yang bisa langsung diterapkan ke dalam kompiler Dev-Pascal.

program menghitung_nilai_mahasiswa;
uses wincrt;
var
nama,grade,ket : string;
nilai,absen,tm,uts,uas : integer;

begin
writeln('PROGRAM MENGHITUNG NILAI MAHASISWA');
writeln('==================================');
writeln;
write('Masukan Nama Mahasiswa : ');readln(nama);
writeln('=======================');

writeln;
writeln('Masukan Nilai Mahasiswa');
writeln('=======================');
write('Nilai Absensi : ');readln(absen);
write('Nilai Tugas Mandiri : ');readln(tm);
write('Nilai UTS : ');readln(uts);
write('Nilai UAS : ');readln(uas);
nilai := (10*absen + 15*tm + 25*uts + 50*uas) div 100;

if nilai > 85 then
grade:= 'A'
else
if (nilai > 75) and (nilai < 85) then
grade:= 'B'
else
if (nilai > 65) and (nilai < 75) then
grade:= 'C'
else
if (nilai > 50) and (nilai < 65) then
grade:= 'D'
else
if (nilai > 0) and (nilai < 50) then
grade:= 'E'
else
grade:= 'F';

case nilai of
85..100 : ket:=('LULUS MEMUASKAN');
75..84 : ket:=('LULUS BAIK');
65..74 : ket:=('LULUS CUKUP');
else
ket:=('TIDAK LULUS');
end;
writeln;
writeln('MAKA HASILNYA ADALAH :');
writeln('======================');
writeln('Hasil nilai akhir ' ,nama, ' adalah ' ,nilai);
writeln('Grade yang didapat adalah ' ,grade, ' maka anda dinyatakan ' ,ket);
writeln;
writeln('==========EDITED BY : TIAN CHAN==========');
writeln('=========================================');
writeln('TERIMAKASIH TELAH MENGGUNAKAN PROGRAM INI');
readln;
end.

Berikut hasil output Program Menghitung Nilai Mahasiswa yang dihasilkan.

Sekian program tentang Source Code Program Menghitung Nilai Mahasiwa dalam Pascal, semoga bermanfaat.

Program Sorting dalam Pascal

Program Sorting dalam Pascal - Software house kali ini membahas tentang kumpulan source code pascal tentang Selection Sort, Bubble Sort, Quick Sort dan Insert Sort.

Berikut ini source code sorting menggunakan compiler dev-pascal :

uses crt;
const
   jml = 5000;
type
   arr = array[1..jml] of integer;
var
   p,q,k,i,x,ms,j,max: integer;
   data: arr;
   lagi,y: char;

procedure nama;
begin
clrscr;
   gotoxy(33,2) ; writeln('**_Struktur Data_**');
   gotoxy(1,4)  ; writeln('================================================================================');
   gotoxy(35,6) ; writeln('Ditujukan Kepada');
   gotoxy(20,8) ; writeln('Nama Dosen   : Ramdhani Hidayat, S.Kom, M.M.');
   gotoxy(40,11); writeln('****');
   gotoxy(20,14); writeln('Disusun oleh : ');
   gotoxy(20,16); writeln('Kelompok     : I (Satu)');
   gotoxy(20,18); writeln('Anggota      : ');
   gotoxy(35,18); writeln('- Fedri Kurniawan');
   gotoxy(35,20); writeln('- M. Ilma Nur Irfan');
   gotoxy(35,22); writeln('- Topan Setiawan');
   gotoxy(35,24); writeln('- Yuliana Dwi Eftiana');
   gotoxy(20,26); writeln('Kelas        : Manajemen Informatika/A');
   gotoxy(20,28); writeln('Semester     : II (Dua)');
   gotoxy(24,32); writeln('Akademi Manajemen Informatika dan Komputer');
   gotoxy(40,36); write('****');
readln;
end;

procedure menu;
begin
clrscr;
   while (x > 5000) or (x < 2) do
   begin
   gotoxy(24,4); write('Berapa data yang akan di inputkan : '); readln(max);
        if (max > 5000) or (max < 2) then
           begin
              gotoxy(20,8); write('Data yang dimasukan tidak boleh lebih dari 5000');
              gotoxy(20,10); write('Tekan enter untuk mengulang !!!');
              readln;
              clrscr;
           end
           else
   begin
   clrscr;
   gotoxy(30,2); write('**_Masukan data dari x1..xn');
   gotoxy(1,4) ; write('================================================================================');
   writeln;
   for x:= 1 to max do
      begin
         write('Bilangan ke ',x,' = '); readln(data[x]);
         writeln;
      end;
   end;
   end;
   clrscr;
      gotoxy(29,2); write('**_Data sebelum diurutkan_**');
      writeln;
      writeln;
   writeln('================================================================================');
      for x:= 1 to max do
   write(data[x],' ');
   gotoxy(1,14) ; writeln('================================================================================');
   gotoxy(3,16) ; writeln('**_Metode Sort_**'    );
   gotoxy(3,18) ; writeln('1. Selection Sort'    );
   gotoxy(3,20) ; writeln('2. Bubble Sort'       );
   gotoxy(3,22) ; writeln('3. Quick Sort'        );
   gotoxy(3,24) ; writeln('4. Insert Sort'       );
   gotoxy(3,26) ; writeln('5. Exit'              );
   gotoxy(40,39); write('****');
   ms:= 0;
   while (ms < 1) or (ms > 5) do
   begin
   gotoxy(3,28) ; write('Masukan Pilihan (1-5): ');
   readln(ms);
      if (ms < 1) or (ms > 5) then
      clrscr;
         write(^G);
    end;
end;

procedure change(var a,b: integer);
var
   c: integer;
   begin
      c:=a;   a:=b;   b:=c;
   end;

procedure Asc_Selection;
var
   pos: integer;
   begin
      for i:= 1 to max-1 do
         begin
            pos:= i;
            for j:= i+1 to max do
               if (data[j]) < (data[pos]) then
                  pos:= j;
               if i <> pos then
                  change(data[i], data[pos]);
         end;
   end;

procedure Desc_Selection;
var
   pos: integer;
   begin
      for i:= 1 to max-1 do
         begin
            pos:= i;
            for j:= i+1 to max do
               if (data[pos]) < (data[j]) then
                  pos:= j;
               if i <> pos then
                  change(data[i], data[pos]);
         end;
   end;

procedure Asc_Bubble;
var
   flag: boolean;
   begin
      flag:= false;
      p:= 2;
      while (p<max) and (not flag) do
      begin
         flag:= true;
         for q:= max downto p do
            if data[q] < data [q-1] then
               begin
                  change (data[q], data[q-1]);
                  flag:= false;
               end;
            inc (i);
      end;
   end;

procedure Desc_Bubble;
var
   flag: boolean;
   begin
      flag:= false;
      p:= 2;
      while (p<max) and (not flag) do
      begin
         flag:= true;
         for q:= max downto p do
            if data[q] > data [q-1] then
               begin
                  change (data[q], data[q-1]);
                  flag:= false;
               end;
            inc (i);
      end;
   end;

procedure Asc_Quick(L, R: integer);
var
   mid: integer;
   begin
      j:= L;   k:= R;   mid:=(L+R) div 2;
      repeat
         while data[j] < data[mid] do inc(j);
         while data[k] > data[mid] do dec(k);
         if j <= k then
            begin
               change (data[j], data[k]);
               inc(j); dec(k);
            end;
      until j>k;
      if L<k then Asc_Quick(L,k);
      if j<R then Asc_Quick(j,R);
   end;

procedure Desc_Quick(L, R: integer);
var
   mid: integer;
   begin
      j:= L;   k:= R;   mid:=(L+R) div 2;
      repeat
         while data[j] > data[mid] do inc(j);
         while data[k] < data[mid] do dec(k);
         if j <= k then
            begin
               change (data[j], data[k]);
               inc(j); dec(k);
            end;
      until j>k;
      if L<k then Desc_Quick(L,k);
      if j<R then Desc_Quick(j,R);
   end;

procedure Asc_Insert;
var
   temp: integer;
   begin
      for i:= 2 to max do
         begin
            temp:= data[i];
            j:= i-1;
            while (data[j] > temp) and (j>0) do
               begin
                  data[j+1]:= data[j];
                  dec(j);
               end;
                  data[j+1]:= temp;
         end;
   end;

procedure Desc_Insert;
var
   temp: integer;
   begin
      for i:= 2 to max do
         begin
            temp:= data[i];
            j:= i-1;
            while (data[j] < temp) and (j>0) do
               begin
                  data[j+1]:= data[j];
                  dec(j);
               end;
                  data[j+1]:= temp;
         end;
   end;

procedure output;
begin
clrscr;
   gotoxy(29,2); write('**_Data setelah diurutkan_**');
   gotoxy(1,4) ; write('================================================================================');
   gotoxy(35,6); write('**_Ascending_**');
   writeln;
   writeln;
   writeln;
   for x:= max downto 1 do
      write(data[x],' ');
   gotoxy(35,19); write('**_Descending_**');
   writeln;
   writeln;
   writeln;
   for x:= 1 to max do
      write(data[x],' ');
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln;
   writeln('================================================================================');
end;

begin
clrscr;
   nama;
   begin
   lagi:='y';
   while upcase(lagi)='Y' do
      begin
      menu;
      if ms=1 then
            begin
               Asc_Selection;
               Desc_Selection;
            end
         else
         if ms=2 then
            begin
               Asc_Bubble;
               Desc_Bubble;
            end
         else
         if ms=3 then
            begin
               Asc_Quick(1,max);
               Desc_Quick(1,max);
            end
         else
         if ms=4 then
            begin
               Asc_Insert;
               Desc_Insert;
            end
         else
               exit;
            output;
                gotoxy(29,32); write('Coba metode yang lain [Y/T] ? ');
                readln(lagi);
      end;
   end;
end. 

Sekian artikel tentang Program Sorting dalam Pascal, semoga bermanfaat.