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.
Home » Pemograman » contoh pemograman pascal linkedlist antrian mahasiswa Konten Lain di Sini
0 comments
Tambahkan Komentar Anda
semua berawal dari diri kita