Program Data Pegawai Perpustakaan

program data_pegawai;

uses crt;

type

dat = record

nama   : string[30];

nidn   : string[10];

alamat : string[25];

pegawai : word;

end;                           

var

filedat : file of dat;

data : dat;

pil,Ul : char;

i,x,y : integer;

procedure Menu;

begin

clrscr;

textcolor(white);

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

textcolor(white);

writeln(' Data Pegawai Perpustakaan Universitas Cokroaminoto Palopo ');

textcolor(white);

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

textcolor(white);

x:=10; y:=8;

gotoxy(x,y+1); write('1. Tambah Data Pegawai ');

gotoxy(x,y+3); write('2. Tampilkan Data Pegawai ');

gotoxy(x,y+5); write('3. Hapus Data Pegawai ');

gotoxy(x,y+7); write('4. Edit Data Pegawai ');

gotoxy(x,y+9); write('5. Keluar ');

gotoxy(10,y+12); write('Pilih Nomor 1 Sampai 5: '); pil:=readkey

end;

procedure bukafile;

begin

assign (filedat,'dat.txt');

{$i-};

reset (filedat);

{si+};

end;

procedure Tambah;

var

lagi : char;

ada : boolean;

i : integer;

NOCR : word;

begin

Ul := 'Y';

lagi :='Y';

clrscr;

bukafile;

if IOResult<>0 then

rewrite (filedat);

repeat

clrscr;

textcolor(white);

ada:=false;

i:=0;

x:=10; y:=5;

gotoxy(x,y-1); write('----------------------- ');

gotoxy(x,y); write (' Tambah Data Pegawai ');

gotoxy(x,y+1); write('----------------------- ');

gotoxy(x,y+2); write('Kode : ');readln (NOCR);

while (ada=false) and (i<>filesize(filedat)) do

begin

seek(filedat,i);

read(filedat,data);

if data.pegawai=NOCR then

ada:=true

else

inc(i);

end;

if (ada=true) then

begin

gotoxy(x,y+7);write('Kode ',NOCR,' sudah ada !');

end

else

begin

seek(filedat,filesize(filedat));

data.pegawai:=nocr;

gotoxy(x,y+4);write('Nama        :');readln(data.nama);

gotoxy(x,y+5);write('NIDN        : ');readln(data.nidn);

gotoxy(x,y+6);write('Alamat      : ');readln(data.alamat);

write (filedat,data);

end;

textcolor(white);

gotoxy(x,y+10);write('Tambah Data Lagi ? Y/T : ');lagi:=upcase(readkey);

until lagi<>'Y';

close(filedat);

end;

procedure output;

var

lagi : char;

ada : boolean;

i : integer;

nocr : word;

begin

ul :='Y';

lagi:='Y';

clrscr;

textcolor(white);

bukafile;

if IOresult<>0 then

write ('Data Masih Kosong ')

else

begin

repeat

clrscr;

textcolor(white);

ada:=false;

i:=0;

x:=10; y:=2;

gotoxy (x,y+1); write ('------------------------------------');

gotoxy (x,y+2); write (' Lihat Data Pegawai ');

gotoxy (x,y+3); write ('------------------------------------');

gotoxy (x,y+4); write('Kode : ');readln(nocr);

while (ada=false) and (i<>filesize (filedat)) do

begin

seek (filedat,i);

read (filedat,data);

if data.pegawai=nocr then

begin

textcolor(white);

ada:=true;

x:=10; y:=15;

gotoxy (x,y+1); write('---------------------------------------------------------------------');

gotoxy (x+0,y+2); write('Lihat Data Pegawai ');

gotoxy (x+0,y+3); write('---------------------------------------------------------------------');

gotoxy (x,y+4); write('Nama           : '); writeln (data.nama);

gotoxy (x,y+5); write('NIDN           : ');writeln (data.nidn);

gotoxy (x,y+6); write('Alamat         : ');writeln (data.alamat);

end

end;

gotoxy(10,13);write('Lihat Data Lagi? Y/T : ');lagi:=upcase(readkey);

until lagi<>'Y';

end;

close(filedat);

end;

procedure Edit;

var

lagi : char;

ada : boolean;

i : integer;

nocr : word;

begin

ul :='Y';

lagi:='Y';

clrscr;

textcolor(white);

bukafile;

if IOresult<>0 then

write ('Data Masih Kosong ')

else

begin

repeat

clrscr;

textcolor(white);

ada:=false;

i:=0;

x:=10; y:=2;

gotoxy (x,y+1); write ('------------------------------------');

gotoxy (x,y+2); write (' Edit Data Pegawai ');

gotoxy (x,y+3); write ('------------------------------------');

gotoxy (x,y+4); write('Kode : ');readln(nocr);

while (ada=false) and (i<>filesize (filedat)) do

begin

seek (filedat,i);

read (filedat,data);

if data.pegawai=nocr then

begin

textcolor(white);

ada:=true;

x:=10; y:=15;

gotoxy (x,y+1); write('---------------------------------------------------------------------------------');

gotoxy (x+0,y+2); write('         Data Awal                            |        Data Setelah Edit       ');

gotoxy (x+0,y+3); write('-------------------------------------------------------------------------------');

gotoxy (x,y+4); write('Nama   : ');writeln (data.nama);

gotoxy (x,y+5); write('NIDN   : ');writeln (data.nidn);

gotoxy (x,y+6); write('Alamat : ');writeln (data.alamat);

end

else

inc(i);

end;

if (ada=true) then

begin

textcolor(white);

data.pegawai:=nocr;

x:=47; y:=15;

gotoxy (x,y+4); write('Nama               : ');readln(data.nama);

gotoxy (x,y+5); write('NIDN               : ');readln(data.nidn);

gotoxy (x,y+6); write('Alamat             : ');readln(data.alamat);

seek(filedat,i);

write(filedat,data);

end

else

begin

textcolor(white);

gotoxy(10,11);write('Kode Mahasiswa ',nocr,' Tidak Ada ');

end;

textcolor(white);

gotoxy(10,13);write('Edit Lagi? Y/T ');lagi:=upcase(readkey);

until lagi<>'Y';

end;

close(filedat);

end;

procedure Hapus;

var

filetmp : file of dat;

hapus: char;

ada : boolean;

i : integer;

nocr : word;

begin

Ul :='Y';

hapus:='Y';

clrscr;

repeat

bukafile;

if ioresult<>0 then

write('Data Masih Kosong ')

else

begin

clrscr;

textcolor(white);

assign(filetmp,'dat.tmp');

rewrite(filetmp);

ada:=false;

i:=0;

x:=10; y:=2;

gotoxy (x+2,y); write('Hapus Data Pegawai ');

gotoxy (x+1,y+1); write('----------------------');

gotoxy (x,y+2); write('Kode : ');readln(nocr);

while (ada=false) and (i<>filesize(filedat)) do

begin

seek(filedat,i);

read(filedat,data);

if data.pegawai=nocr then

ada:=true

else

inc(i);

end;

if (ada=true) then

begin

gotoxy (x,y+4); write('Nama            : ');writeln(data.nama);

gotoxy (x,y+5); write('NIDN            : ');writeln(data.nidn);

gotoxy (x,y+6); write('Alamat          : ');writeln(data.alamat);

gotoxy (x,y+10); write('Hapus Data Ini ? Y/T : ');readln (hapus);

if upcase (hapus)='Y' then

begin

for i :=1 to filesize(filedat) do

begin

seek(filedat,i-1);

read(filedat,data);

if data.pegawai<>nocr then write(filetmp,data);

end;

close(filedat);

assign(filedat,'dat.txt');

erase(filedat);

assign(filetmp,'data.tmp');

rename(filetmp,'dat.txt');

gotoxy(x-8,y+12);write('Kode ',nocr,' Sudah Dihapus ');

end;

end

else

begin

gotoxy(x-4,y+13);write('Kode ini Sudah Dihapus',nocr,' Sudah Dihapus ');

end;

gotoxy(x-3,y+15);write('Hapus Data Yang Lain ? Y/T : ');hapus :=upcase(readkey);

end;

until hapus<>'Y';

end;

begin

clrscr;

textcolor(white);

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

textcolor(white);

writeln(' Data Pegawai Perpustakaan Universitas Cokroaminoto Palopo ');

textcolor(white);

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

textcolor(white);

x:=10; y:=8;

gotoxy(x,y+1); write('1. Tambah Data Pegawai ');

gotoxy(x,y+3); write('2. Tampilkan Data Pegawai ');

gotoxy(x,y+5); write('3. Hapus Data Pegawai ');

gotoxy(x,y+7); write('4. Edit Data Pegawai ');

gotoxy(x,y+9); write('5. Keluar ');

begin

gotoxy(10,y+12); write('Pilih Nomor 1 Sampai 5: '); pil:=readkey;

end;

begin

repeat

menu;

case pil of

'1' : Tambah;

'2' : output;

'3' : Hapus;

'4' : Edit;

'5' : Exit;

end;

until(ul<>'Y')or (pil='5');

end;

end.

Source Code

1. STACK (TUMPUKAN)

2. QUEUE

-        Source Code

program praktikum_3;

uses crt;

type pointer=^node;

     node=record

         nama : string;

         alamat : string;

         next : pointer;

     end;

     queue=record

          front,rear : pointer;

     end;

var baru : pointer;

    q : queue;

    nm,al : string;

procedure AddQ(var q : queue; baru : pointer);

begin

     if q.front = nil then

     begin

          q.front :=baru;

          q.rear :=baru;

end

else

begin

     q.rear^.next :=baru;

     q.rear :=baru;

   end;

end;

procedure deleteQ(var q : queue);

var hapus : pointer;

begin

     if q.front<>nil then

     begin

          hapus :=q.front;

          q.front :=q.front^.next;

          {hasil^:=hapus^;}

          dispose(hapus);

     end;

end;

procedure cetak(q : queue);

var b : pointer;

begin

     if q.front = nil then

        writeln('kosong')

     else

     begin

         new(b);

         b := q.front;

         while b<>q.rear do

         begin

              writeln(b^.nama,' ',b^.alamat);

              b :=b^.next;

         end;

         writeln(b^.nama,' ',b^.alamat);

     end;

     writeln;

end;

begin

      clrscr;

      repeat

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

            write('alamat      :');readln(al);

            new(baru);

            with baru^ do

            begin

                 nama :=nm;

                 alamat :=al;

                 next :=nil;

            end;

            AddQ(q,baru);

            writeln('Enter terus / ESC cukup');

      until readkey = #27;

      repeat

            cetak(q);

            deleteQ(Q);

      until readkey = #27;

End.

3. Linked-List

-  Source Code

program praktikum_4;

uses crt;

type pointer = ^node;

     node = record

           data : string;

           next : pointer;

     end;

var n,name : string;

    i : byte;

    p,q,baru : pointer;

procedure sisip(var p,q : pointer; baru : pointer);

begin

     if p = nil then

        begin

              p :=baru;

              q :=baru;

        end

        else

        begin

              q^.next :=baru;

              q :=baru;

        end;

end;

procedure hapuskan(var p : pointer; name : string);

var bantu,hapus : pointer;

begin

     if p <> nil then

        begin

             hapus :=p;

             while (hapus^.next <> nil) and (hapus^.data <> name) do

                    hapus := hapus^.next;

             if hapus^.data <> name then

                writeln('Data tidak ada')

             else

             begin

                   bantu := p;

                   if bantu = hapus then

                      p := hapus^.next

                   else

                        while bantu^.next <> hapus do

                              bantu := bantu^.next;

                   bantu^.next := hapus^.next;

                   dispose(hapus);

             end;

        end;

end;

procedure cetak(p,q : pointer);

var bantu : pointer;

begin

     bantu := p;

     while bantu <> nil do

     begin

          write(bantu^.data,' ');

          bantu :=bantu^.next;

     end;

end;

begin

     clrscr;

     repeat

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

           for i := 1 to Length (n) do

               n[i] := upcase (n[i]);

           new (baru);

           with baru^do

           begin

                data := n;

                next := nil;

           end;

           sisip(p,q,baru);

           writeln('Enter terus / ESC cukup');

     until readkey = #27;

     cetak(p,q);

     repeat

           write('Nama yang akan dihapus :');readln(name);

           for i := 1 to length (name) do

               name[i] :=upcase (name[i]);

           hapuskan(p,name);

           cetak(p,q);

           if p = nil then

              writeln('Linked-List kosong');

              writeln('Enter terus / ESC cukup');

     until readkey = #27;

end.

- Hasil

4. Double Linked List Melingkar”

-        - Source Code

program Praktikum_6;

uses crt;

Type pointer = ^node;

     node = record

          isi : integer;

          kiri,kanan : pointer;

     end;

var baru,p : pointer;

    n : integer;

procedure Sisip (var p : pointer; baru : pointer);

var bantu : pointer;

begin

     if p^.kanan = nil then

     begin

           p^.kanan := baru;

           baru^.kiri := p;

           baru^.kanan := p;

           p^.kiri := baru;

     end

     else

     if baru^.isi < p^.kanan^.isi then

     begin

           baru^.kanan := p^.kanan;

           baru^.kanan^.kiri := baru;

           baru^.kiri := p;

           baru^.kiri^.kanan := baru;

     end

     else

     begin

           bantu := p;

           while (bantu^.kanan <> p) and (baru^.isi > bantu^.kanan^.isi) do

           bantu := bantu^.kanan;

           if bantu^.kanan <> p then

     begin

           baru^.kanan := bantu^.kanan;

           baru^.kiri := bantu;

           baru^.kiri^.kanan := baru;

           baru^.kanan^.kiri := baru;

     end

     else

     begin

           baru^.kiri := bantu;

           baru^.kanan := baru^.kiri^.kanan;

           baru^.kiri^.kanan := baru;

           baru^.kanan^.kiri := baru;

     end;

end;

end;

procedure hapuskan (var p : pointer; n : integer);

var hapus : pointer;

    ada : boolean;

begin

     hapus := p;

     ada := false;

     while (hapus^.kanan <> p) and (not(ada)) do

     begin

          hapus := hapus^.kanan;

          if n = hapus^.isi then

             ada := true

          end;

          if not (ada) then

             writeln('Data tidak ada')

          else

          if hapus^.kanan = p then

          begin

                hapus^.kiri^.kanan := hapus^.kanan;

                hapus^.kanan^.kiri := hapus^.kiri;

                dispose (hapus);

          end

          else

          begin

                hapus^.kiri^.kanan := hapus^.kanan;

                hapus^.kanan^.kiri :=hapus^.kiri;

                dispose (hapus);

          end;

end;

procedure cetak (p : pointer);

var b : pointer;

begin

     b := p;

     while b^.kanan <> p do

     begin

          b := b^.kanan;

          writeln (b^.isi, ' ');

     end;

     writeln;

     if b = p then

        writeln('Linked-list kosong');

end;

begin

      clrscr;

      new (p);

      with p^ do

      begin

           kiri := nil;

           kanan := nil;

      end;

      repeat

            write('Isi : '); readln(n);

            new (baru);

            with baru^ do

            begin

                isi := n;

                kanan := nil;

                kiri := nil;

            end;

            sisip (p, baru);

            writeln('Enter terus / ESC cukup');

            until readkey = #27;

            cetak(p);

            repeat

                  write('Data yang akan dihapus :');readln(n);

                  hapuskan(p,n);

                  cetak(p);

                  writeln('Enter terus / ESC cukup');

            until readkey = #27;

End.

5. Graph

-        Source  Code

program praktikum_7;

uses crt, graph;

var

pilihan2, pilihan : char;

x1,x2,y1,y2,a,b,xa,xb,ya,yb:integer;

grDriver: integer;

grMode: integer;

ErrCode: integer;

skala:integer;

begin

clrscr;

writeln('yang ingin anda proses');

write(' 1 = translasi garis');

write(' 2 = refleksi garis');

write(' 3 = dilatasi garis');

write(' 4 = rotasi garis');

write('Tentukan Pilihan Anda= ');readln(pilihan);

if pilihan = '1' then

  begin

  write('masukkan x1 = ');readln(x1);

  write('masukkan y1 = ');readln(y1);

  write('masukkan x2 = ');readln(x2);

  write('masukkan y2 = ');readln(y2);

  writeln('masukkan titik translasi (a,b)');

  write('a = ');readln(a);

  write('b = ');readln(b);

  xa:=x1+a; xb:=x2+a;

  ya:=y1+b; y2:=y2+b;

end

else

if pilihan = '2' then

  begin

  writeln(' 1 = garis terhadap sumbu y ');

  writeln(' 2 = garis terhadap sumbu x ');

  readln(pilihan2);

  writeln(' titik yang akan di refleksikan ');

  write(' x1 = ');readln(x1);

  write(' y1 = ');readln(y1);

  write(' x2 = ');readln(x2);

  write(' y2 = ');readln(y2);

  if pilihan2 = '1' then

  begin

      xa:=(-1*x1);

      xb:=(-1*x2);

      ya:=y1; yb:=y1;

  end

else

if pilihan2 = '2' then

   begin

      ya:=(-1*y1); xa:=x1;

      yb:=(-1*y2); xb:=x2;

   end;

end

else

if pilihan = '3' then

   begin

      write('masukkan x1 = ');readln(x1);

      write('masukkan y1 = ');readln(y1);

      writeln(' 1 = terhadap titik pusat');

      write(' 2 = terhadap titik (a,b)');readln(pilihan2);

      write('masukkan faktor skala = ');readln(skala);

if pilihan2 = '1' then

   begin

      x2:=skala*x1;

      y2:=skala*y1;

   end;

if pilihan2 = '2' then

   begin

      write('masukkan a = ');readln(xa);

      write('masukkan b = ');readln(xb);

      x2:=xa+(skala*(x1-xa));

      y2:=yb+(skala*(y1-yb));

   end;

end;

grDriver := Detect;

InitGraph(grDriver, grMode,' ');

ErrCode := GraphResult;

if ErrCode = grOk then

   begin { Do graphics }

      Line(320, 0, 320, 640);

      Line(0, 230, 640, 230);

if pilihan = '1' then

   begin

      line((x1+320), (-y1+230), (x2+320), (-y2+230));

      line((xa+320), (-ya+230), (xb+320), (-yb+230));

   end

else

if pilihan = '2' then

   begin

      line((x1+320), (-y1+230), (x2+320), (-y2+230));

      line((xa+320), (-ya+230), (xb+320), (-yb+230));

   end

else

if pilihan = '3' then

   begin

      line((x1+320), (-y1+230), (x2+320), (-y2+230));

   end;

readln;

CloseGraph;

end

else

writeln('Graphics error:', GraphErrorMsg(ErrCode));

readln

end.

6. Binery Tree

. Source Code

program praktikum_tree;                                   {tugas no. 1)

uses crt;                                                            {tugas no. 1)

type btree = ^node;

     node = record

     isi : char;

     a_kiri,a_kanan : btree;

   end;

var baru,root : btree;                                         {tugas no. 2}

    pilih,x : char;                                                            {tugas no. 2}

procedure sisip(var root : btree; baru : btree);     {tugas no. 2}

var p : btree;                                                     {tugas no. 2}   

begin

    baru^.a_kiri := nil;

    baru^.a_kanan := nil;

    if root = nil then

       root := baru

    else

    begin

          p := root;

          while p <> nil do

                if baru^.isi < p^.isi then

                   if p^.a_kiri <> nil then

                      p := p^.a_kiri

                   else

                   begin

                        p^.a_kiri := baru;

                        p := nil;

                   end

                   else

                   if p^.a_kanan <> nil then

                      p := p^.a_kanan

                   else

                   begin

                      p^.a_kanan := baru;

                      p := nil;

                   end;

          end;

end;

procedure inorder(root : btree);

begin

     if root <> nil then

     begin

           inorder(root^.a_kiri);

           write(root^.isi,' ');

           inorder(root^.a_kanan);

     end;

     writeln;

end;

procedure postorder(root : btree);                                              

begin

     if root <> nil then

     begin

          postorder(root^.a_kiri);                                                    {tugas lab no. 3}

          postorder(root^.a_kanan);

          write(root^.isi,' ');

     end;

     writeln;

end;

procedure preorder(root : btree);

begin

     if root <> nil then

     begin

          write(root^.isi,' ');

          preorder(root^.a_kiri);

          preorder(root^.a_kanan);                                                 {tugas lab no. 4}

     end;

     writeln;

end;

begin

     clrscr;

     repeat

          new(baru);

          write('Masukkan huruf : '); readln(x);

          baru^.isi := x;

          sisip(root,baru);

          writeln('Tekan anykey to lanjut / ESC to stop');

     until readkey = #27;

     writeln;

     writeln;

     writeln('Mau cetak secara apa');

     writeln;

     repeat

          writeln('1. INORDER');

          writeln('2. POSTORDER');

          writeln('3. PREORDER');

          writeln('4. Keluar');

          write('Masukkan pilihan anda :'); readln(pilih);

          writeln;

          case pilih of                                                                    {tugas no. 5}

               '1' : inorder(root);

               '2' : postorder(root);

               '3' : preorder(root);

          end;

     until pilih = '4';

end.