Monday, March 30, 2015

Program Bobot Nilai (Pascal)

Kudena.blogspot.com-Senen(30/3) , hay anak-anak kuliah yang sedang galau dengan program pascal,ini nih ada contoh tugas pascal larik dalam record Program Nilai Mahasiswa,penasaran ? langsung copas dan perlajari saja kode dibawah ini :

program program_mhs;
uses crt;

const max=10;

type mhsku=record
nim,nama:string;
mk:array[1..max] of string;
sks:array[1..max] of byte;
nilai:array[1..max] of char;
ip:real;
end;
larik=array[1..max] of mhsku;

var mhs:larik;
i,j,m,jumsks,pil:byte;
n:array[1..max] of byte;

function bobot(y:char):byte;
begin
case y of
'A':bobot:=4;'a':bobot:=4;
'B':bobot:=3;'b':bobot:=3;
'C':bobot:=2;'c':bobot:=2;
'D':bobot:=1;'d':bobot:=1;
'E':bobot:=0;'e':bobot:=0;
'0':bobot:=0; end;
end;

procedure isi_data(var x:larik);
var mutu:real; ni,ya:char;
begin
repeat
clrscr;
jumsks:=0;mutu:=0;
writeln('isi identitas mahasiswa');
inc(m);
write('masukkan nim     :   > ');readln(x[m].nim);
write('masukan nama     :  > ');readln(x[m].nama);
write('banyaknya matkul : > ');readln(n[m]);writeln;
for i:=1 to n[m] do
begin
write('mata kuliah ke ',i,' : ');readln(x[m].mk[i]);
write('sks    : ');readln(x[m].sks[i]);
write('nilai  : ');readln(ni);
if (ni<>'A')and(ni<>'a')and(ni<>'B')and(ni<>'b')and
(ni<>'C')and(ni<>'c')and(ni<>'D')and(ni<>'d')and
(ni<>'E')and(ni<>'e') then begin writeln('salah');readln;exit;end else
x[m].nilai[i]:=ni;
jumsks:=jumsks+x[m].sks[i];
mutu:=mutu+ (bobot(x[m].nilai[i])*x[m].sks[i]);
writeln;
end;
x[m].ip:=mutu/jumsks;
write('isi lagi ? > ');readln(ya);
until (ya<>'y') or (m>=max);
end;

procedure cetak_semua(x:larik);
begin
clrscr;
writeln('cetak semua');writeln;
for i:=1 to m do
begin
writeln('data mahasiswa ke ',i);
jumsks:=0;
writeln('nim  = ',x[i].nim);
writeln('nama = ',x[i].nama);writeln;
writeln('-------------------------------------------------');
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
writeln('-------------------------------------------------');
for j:=1 to n[i] do
writeln(j:2,x[i].mk[j]:20,x[i].sks[j]:6,x[i].nilai[j]:6,bobot(x[i].nilai[j])*x[i].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[i].ip:0:2);
writeln;writeln('----------------------------------------');
end;
readln;
end;

procedure cetak_nomor(x:larik);
var no:byte;
begin
clrscr;
jumsks:=0;
writeln('cetak nomor');writeln;
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:20,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[no].ip:0:2);
end;
readln;
end;

procedure cetak_nim(x:larik);
var nims:string;pos:byte;ada:boolean;
begin
clrscr;
jumsks:=0;ada:=false;
writeln('cetak nim');writeln;
write('nim > ');readln(nims);
for i:=1 to m do if x[i].nim=nims then begin ada:=true;pos:=i; end;
if not ada then writeln('nim ',nims,' tidak ditemukan') else
begin
writeln('nim  = ',x[pos].nim);
writeln('nama = ',x[pos].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[pos] do
writeln(j:2,x[pos].mk[j]:20,x[pos].sks[j]:6,x[pos].nilai[j]:6,bobot(x[pos].nilai[j])*x[pos].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[pos].ip:0:2);
end;
readln;
end;

procedure cetak_data(var x:larik);
var pil1:byte;
begin
repeat
clrscr;
writeln('cetak data');
writeln(' 1. cetak semua');
writeln(' 2. cetak berdasar nomor record');
writeln(' 3. cetak berdasar nim');
writeln(' 4. kembali');
write('pilih > ');readln(pil1);
case pil1 of
1: cetak_semua(x);
2: cetak_nomor(x);
3: cetak_nim(x);
4: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil1=4;
readln;
end;

procedure tampilkan(x:larik);
begin
writeln('no':2,'nim':12,'nama':18);
for i:=1 to m do writeln(i:2,x[i].nim:12,x[i].nama:18);
end;

procedure edit_identitas(var x:larik);
var no,pil2:byte;
begin
clrscr;
writeln('edit identitas');
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('1. nim  =',x[no].nim);
writeln('2. nama =',x[no].nama);
writeln('3. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('nim baru  > ');readln(x[no].nim); end;
2: begin write('nama baru > ');readln(x[no].nama); end;
3: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=3;
end;
end;

procedure edit_mk(var x:larik);
var no,no2,pil2:byte;
begin
clrscr;
writeln('edit mata kuliah');
write('masukkan nomor record : ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk : ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
repeat
clrscr;
writeln('1. matkul  = ',x[no].mk[no2]);
writeln('2. sks     = ',x[no].sks[no2]);
writeln('3. nilai   = ',x[no].nilai[no2]);
writeln('4. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('matkul baru : ');readln(x[no].mk[no2]); end;
2: begin write('sks baru    : ');readln(x[no].sks[no2]); end;
3: begin write('nilai baru  : ');readln(x[no].nilai[no2]); end;
4: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=4;
end;
readln;
until no2=j+1;
end;
end;

procedure edit_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. edit identitas');
writeln(' 2. edit mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else edit_identitas(x);
2: if m=0 then writeln('belum ada data.') else edit_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

procedure hapus_mahasiswa(var x:larik);
var no:byte;ya2:char;
begin
clrscr;
jumsks:=0;
writeln('hapus mahasiswa');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  =',x[no].nim);
writeln('nama =',x[no].nama);
write('yakin ingin menghapus : ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no to m-1 do x[i]:=x[i+1];
x[m].nim:='';
x[m].nama:='';
for j:=1 to n[m] do
begin
x[m].mk[j]:='';
x[m].sks[j]:=0;
x[m].nilai[j]:='0';
end;
dec(m);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
end;

procedure hapus_mk(var x:larik);
var no,no2:byte;ya2:char;
begin
clrscr;
writeln('hapus mata kuliah');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk > ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
writeln('matkul  =',x[no].mk[no2]);
writeln('sks     =',x[no].sks[no2]);
writeln('nilai   =',x[no].nilai[no2]);
write('yakin ? > ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no2 to n[no2]-1 do begin x[no].mk[i]:=x[no].mk[i+1];x[no].sks[i]:=x[no].sks[i+1];x[no].nilai[i]:=x[no].nilai[i+1]; end;
x[m].mk[n[no2]]:='';
x[m].sks[n[no2]]:=0;
x[m].nilai[n[no2]]:='0';
dec(n[no2]);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
readln;
until no2=j+1;
end;
readln;
end;

procedure hapus_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. hapus mahasiswa');
writeln(' 2. hapus mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else hapus_mahasiswa(x);
2: if m=0 then writeln('belum ada data.') else hapus_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

begin
repeat
clrscr;
writeln('pengolahan data mahasiswa');
writeln(' 1. isi data');
writeln(' 2. cetak data');
writeln(' 3. edit data');
writeln(' 4. hapus data');
writeln(' 5. keluar');
write('pilih > ');readln(pil);
case pil of
1: if m>=max then writeln('sudah penuh.') else isi_data(mhs);
2: if m=0 then writeln('belum ada data.') else cetak_data(mhs);
3: if m=0 then writeln('belum ada data.') else edit_data(mhs);
4: if m=0 then writeln('belum ada data.') else hapus_data(mhs);
5: writeln('sampai jumpa.');
else writeln('pilihan salah.');
end;
readln;
until pil=5;
readln;
end.

No comments:

Post a Comment

Tinggalkan Pesan :