Rabu, 19 Mei 2010

PETRUK 20 Mei 2010

PROGRAM Sort_Record;


uses crt;

CONST MaxData = 100;

TYPE DataSiswa = RECORD

NomorInduk : integer;

Nama : STRING[15];

Nilai : RECORD

PR, Test, Latihan: Real;

END;

NilaiAkhir : Real;

Nilaihuruf : Char;

end;

DaftarSiswa = Array[1..MaxData] Of DataSiswa;

Var Siswa : DaftarSiswa;{Daftar para Siswa}

JumSiswa : Integer;{Jumlah Siswa}



Procedure BacaDataSiswa;

var Lagi : char;



Function NilHuruf(NILAI : REAL) : Char;

Begin

If Nilai >= 80 Then

NilHuruf := 'A'

else if (Nilai < 80) and (Nilai >= 70) then

NilHuruf := 'B'

else if (Nilai < 70) and (Nilai >= 60) then

NilHuruf := 'C'

else if (Nilai < 60) and (Nilai >= 40) then

NilHuruf := 'D'

else

NilHuruf := 'E'

END;



Begin

JumSiswa := 0;

Repeat



JumSiswa := JumSiswa + 1;

{Masukan Data Siswa Ke Jumlah}

WITH Siswa[JumSiswa] DO BEGIN

Writeln('Masukan data siswa : ');

write('nomor Induk : '); readln(NomorInduk);

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

writeln('Nilai-nilai : ');

write('Tugas Rumah : '); readln(Nilai.PR);

write('Latihan : '); readln(nilai.Latihan);

write('Test : '); readln(Nilai.Test);



NilaiAkhir := 0.2*Nilai.PR+0.5*Nilai.Test+0.3*Nilai.Latihan;

NilaiHuruf := Nilhuruf(NilaiAkhir);

End;



{Tanyakan Apakah ada Data lagi}

WRITE('Adakah data lagi (Y/T) ? '); readln(lagi);



{jika jumlah dinaikan satu melebihi data maksimum,tampilkan pesan}

if JumSiswa + 1 > maxData then begin

writeln('Data telah maksimal, segera akan diurutkan! ');

Lagi := 'T';

end;



until UPCASE(lagi) = 'T';

end;



Procedure urutDataSiswa;

var i,j : integer;

tampung : DataSiswa;

Begin

for i := 1 to JumSiswa - 1 do

for j := i + 1 to jumSiswa Do

if siswa[1].Nilaihuruf < Siswa[j].nilaiHuruf then begin

Tampung := Siswa[i];

Siswa[i] := Siswa[j];

Siswa[j] := Tampung;

end;

end;



procedure CetakDataSiswa;

var i : integer;

begin

writeln('No.Induk',' ','Nama':15,' ','N.Akhir',' ','huruf');

for i := 1 To JumSiswa do

with siswa[i] do

writeln(nomorInduk:9,' ',nama:15,' ',NilaiAkhir:6:2,' ',Nilaihuruf)

end;



begin

clrscr;

BacaDataSiswa;



UrutDataSiswa;



CetakDataSiswa;

end.