contoh pemograman pascal linkedlist antrian mahasiswa

uses wincrt;
const max=20;
type pointer=^recpoint;
     recpoint=record
     nama,mp:string;
     berikutnya:pointer;
     end;

type mhs=record
     nama1,mp1:string;
     nilai:real;
     huruf:char;
     end;
type larikmhs=array[1..max] of mhs;
   
var List,akhir:pointer;
    namabaru,mkbaru:string;
    nilaimhs:larikmhs;
    lagi:boolean;n:byte;
    pil:1..7;

procedure tambah_belakang(var L:pointer;nm,mk:string);
var baru:pointer;
begin
new(baru);
baru^.nama:=nm;baru^.mp:=mk;baru^.berikutnya:=nil;
if L=nil then
   begin
        L:=baru;akhir:=baru;
   end
else{tambah akhir}
begin
     akhir^.berikutnya:=baru;
     akhir:=baru;
     akhir^.berikutnya:=nil;
end;
end;

procedure layanan(var L:pointer);
var bantu:pointer;
    tgs,resp:byte;

begin
new(bantu);
if L=nil then writeln('tidak ada mahasiswa di antrean')
else
begin
     bantu:=L;
     L:=bantu^.berikutnya;inc(n);
     nilaimhs[n].nama1:=bantu^.nama;nilaimhs[n].mp1:=bantu^.mp;
     writeln('nama :',nilaimhs[n].nama1,' mata praktikum : ',nilaimhs[n].mp1);
     write('masukkan nilai tugas : ');readln(tgs);
     write('masukkan nilai responsi : ');readln(resp);
     nilaimhs[n].nilai:=(tgs+resp)/2;
     {writeln(nilaimhs[n].nama1,nilaimhs[n].mp1,nilaimhs[n].nilai);}
     if (nilaimhs[n].nilai>=80) then nilaimhs[n].huruf:='A' else if (nilaimhs[n].nilai>=60)
     then nilaimhs[n].huruf:='B' else if (nilaimhs[n].nilai>=40) then nilaimhs[n].huruf:='C'
     else if (nilaimhs[n].nilai>=20) then nilaimhs[n].huruf:='D' else nilaimhs[n].huruf:='E';
end;
dispose(bantu);
end;

procedure cetakList(L:pointer);
var bantu:pointer;
    i:byte;

begin
new(bantu);i:=0;
bantu:=L;
if bantu=nil then writeln('Tidak ada mahasiswa di antrean')
else
begin
     while bantu<>nil do
     begin
          inc(i);
          writeln('posisi ',i,'  ',bantu^.nama,'  ',bantu^.mp);
          bantu:=bantu^.berikutnya;
     end;
end;
end;

procedure Cetakmhs(var x:larikmhs);
var i:byte;

begin
if n=0 then writeln('tidak ada mahasiswa dalam daftar')
else
begin
     writeln('=============================================');
     writeln('no    nama           mata prak      nilai');
     writeln('---------------------------------------------');
     for i:=1 to n do writeln(i:3,x[i].nama1:10,x[i].mp1:10,'  ',x[i].nilai:8:2,' ',x[i].huruf:2);
end;
     writeln('---------------------------------------------');
end;

procedure cari(var x:larikmhs);
var ketemu:boolean;
    i:byte;lagi:char;
    namacari:string;

begin
lagi:='y';
while lagi='y' do
begin
if n=0 then writeln('daftar kosong, anda tdk bisa melakukan pencarian')
else
begin
     ketemu:=false;
     write('nama yang dicari ==> ');readln(namacari);
     for i:=1 to n do
     begin
          if x[i].nama1=namacari then
          begin
               ketemu:=true;
               writeln('nama ',namacari,' ada. Mengambil praktikum ',x[i].mp1,' nilai ',x[i].huruf);
          end;
     end;
     if not ketemu then writeln('nama tersebut tidak ada');
end;
write('mau cari nama lain<y/t> ? ');readln(lagi);
end;
end;
 

begin{program utama}
lagi:=true;List:=nil;
while lagi do
begin
clrscr;
writeln('1. Tambah peserta');
writeln('2. layanan praktikum, pemberian nilai');
writeln('3. Cetak antrian');
writeln('4. Cetak nilai');
writeln('5. Informasi nilai');
writeln('6. Selesai');
writeln('Pilihan anda <1-6> ');readln(pil);
case pil of
1: begin
   writeln('nama baru           ==>  ');readln(namabaru);
   writeln('mata praktikum      ==>  ');readln(mkbaru);
   tambah_belakang(List,namabaru,mkbaru);
   end;
2: layanan(List);
3: cetakList(List);
4: cetakmhs(nilaimhs);
5: cari(nilaimhs);
6: begin   writeln('Terimakasih');lagi:=false;end;
end;
readln;
end;
donewincrt;
end.

0 comments

Tambahkan Komentar Anda

semua berawal dari diri kita

 
Copyright © 2012 wooodiez ~ Template By : Jasriman Sukri

Kamu bisa menulis deskripsi disini