Program Penerimaan Siswa Baru dengan Record pada Pascal ~ coretan asti

25/11/13

Program Penerimaan Siswa Baru dengan Record pada Pascal

Senin, November 25, 2013

coretan asti

Bagi sahabat-sahabat yang sedang belajar record, ada contoh program nih. Ya bisa dikatakan lumayan bagus.hehe
Selamat menyimak...

program record_2;

uses crt;

type siswa=record

nama,alamat,asal,alasal,ttl:string;

jurusan:1..5;

prestasi:1..3;

nem:real;

end;

larik_baru=array[1..17] of siswa;

var sisba,copy:larik_baru;

i,j,x,n,acak:byte;

pil:1..9;

procedure daftar(var a:larik_baru);

var lagi:char;

begin

repeat

begin

inc(n);

writeln('No Pendaftaran ke ',n);

writeln;

write('Nama : ');readln(a[n].nama);

write('Tempat Tanggal Lahir : ');readln(a[n].ttl);

write('Alamat : ');readln(a[n].alamat);

write('Asal Sekolah : ');readln(a[n].asal);

write('Alamat Sekolah : ');readln(a[n].alasal);;

write('Jumlah NEM : ');readln(a[n].nem);

writeln;

writeln('Prestasi yang pernah diraih (0:Tidak, 1:Kabupaten, 2:Nasional, 3:Internasional)');

writeln('Hanya boleh melampirkan 1 prestasi');

write('Prestasi Anda? ');readln(a[n].prestasi);

writeln;

writeln('Pilihan Jurusan:');

writeln(' 1. Teknik Jaringan (TKJ)');

writeln(' 2. Multimedia (MM)');

writeln(' 3. Akuntansi (AK)');

writeln(' 4. Administrasi Perkantoran (AP)');

writeln(' 5. Pemasaran (PM)');

write('Pilihan Jurusan (1/2/3/4/5) : ');readln(a[n].jurusan);

writeln;

write('Daftar Selanjutnya (y/t)? ');readln(lagi);

writeln;

end

until (lagi<>'y');

end;

procedure cetak(var a:larik_baru);

var jur:string;

pres,jumlah,e,b,c,d:real;

begin

clrscr;

writeln(' Data Pendaftar Siswa Baru SMKN 1 Bantul ');

writeln(' Tahun Ajaran 2013/2014 ');

writeln('_______________________________________________________________________________');

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

for i:=1 to n do

begin

e:=0.25;

b:=0.50;

c:=1.00;

d:=0;

with a[i] do

begin

if (a[i].jurusan= 1) then jur:='TKJ' else

if (a[i].jurusan= 2) then jur:='MM' else

if (a[i].jurusan= 3) then jur:='AK' else

if (a[i].jurusan= 4) then jur:='AP' else

jur:='PM';

if (a[i].prestasi=1) then begin pres:=0.25;jumlah:=a[i].nem+e;end else

if (a[i].prestasi=2) then begin pres:=0.50;jumlah:=a[i].nem+b;end else

if (a[i].prestasi=3) then begin pres:=1.00;jumlah:=a[i].nem+c;end else

begin pres:=0.00;jumlah:=a[i].nem+d;end;

writeln('|',i:3,' |',nama:10,' | ',asal:15,' | ',jur:3,' | ',nem:2:2,' | ',pres:2:2,' | ',jumlah:2:2,' |');

end;

writeln('|____|___________|___________________|_________|_______|________|_____________|');

end;

procedure cari(var a:larik_baru);

var search,jur:string;

pres,e,b,c,d,jumlah:real;

tempat:byte;

begin

clrscr;

acak:=0;

write('Siapa yang Anda cari? ');readln(search);

for i:=1 to n do

begin

if (a[i].nama=search) then

begin

tempat:=i;

inc(acak);

writeln(acak,' ',search,' ada di nomor pendaftaran ',tempat,' dengan data sebagai berikut.');

writeln('Nama : ',a[tempat].nama);

writeln('Tempat Tanggal Lahir : ',a[tempat].ttl);

writeln('Alamat : ',a[tempat].alamat);

writeln('Asal Sekolah : ',a[tempat].asal);

writeln('Alamat Sekolah : ',a[tempat].alasal);

writeln('Jumlah NEM : ',a[tempat].nem:2:2);

writeln;

end;

if (acak=0) then writeln('nama ',search,' tidak ada di dalam daftar');

end;

procedure fil_jur(var a:larik_baru);

var lagi:char;

acak:byte;

jur:string;

pres,e,b,c,d,jumlah:real;

begin

repeat

begin

e:=0.25;

b:=0.50;

c:=1.00;

d:=0;

with a[i] do

begin

if (a[i].jurusan= 1) then jur:='TKJ' else

if (a[i].jurusan= 2) then jur:='MM' else

if (a[i].jurusan= 3) then jur:='AK' else

if (a[i].jurusan= 4) then jur:='AP' else

jur:='PM';

if (a[i].prestasi=1) then begin pres:=0.25;jumlah:=a[i].nem+e;end else

if (a[i].prestasi=2) then begin pres:=0.50;jumlah:=a[i].nem+b;end else

if (a[i].prestasi=3) then begin pres:=1.00;jumlah:=a[i].nem+c;end else

begin pres:=0.00;jumlah:=a[i].nem+d;end;

end;

begin

for i:=1 to n do

clrscr;

writeln('Daftar Jurusan');

writeln('1. Teknik Komputer Jaringan');

writeln('2. Multimedia');

writeln('3. Akuntansi');

writeln('4. Administrasi Perkantoran');

writeln('5. Pemasaran');

writeln;

write('Masukkan Pilihan Anda 1/2/3/4/5 : ');readln(pil);

case pil of

1: begin

acak:=0;

writeln;

writeln('Data pendaftar pada jurusan Teknik Komputer Jaringan');

writeln('____________________________________________________________');

writeln('| No | No Daftar | Nama | Asal Sekolah | NEM |');

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

for i:=1 to n do

begin

if (a[i].jurusan=1) then

begin

inc(acak);

end;

writeln('|____|___________|______________|__________________|_______|');

end;

2: begin

acak:=0;

writeln;

writeln('Data pendaftar pada jurusan Multimedia');

writeln('____________________________________________________________');

writeln('| No | No Daftar | Nama | Asal Sekolah | NEM |');

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

for i:=1 to n do

begin

if (a[i].jurusan=2) then

begin

inc(acak);

end;

writeln('|____|___________|______________|__________________|_______|');

end;

3: begin

acak:=0;

writeln;

writeln('Data pendaftar pada jurusan Akuntansi');

writeln('____________________________________________________________');

writeln('| No | No Daftar | Nama | Asal Sekolah | NEM |');

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

for i:=1 to n do

begin

if (a[i].jurusan=3) then

begin

inc(acak);

end;

writeln('|____|___________|______________|__________________|_______|');

end;

4: begin

acak:=0;

writeln;

writeln('Data pendaftar pada jurusan Administrasi Perkantoran');

writeln('____________________________________________________________');

writeln('| No | No Daftar | Nama | Asal Sekolah | NEM |');

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

for i:=1 to n do

begin

if (a[i].jurusan=4) then

begin

inc(acak);

end;

writeln('|____|___________|______________|__________________|_______|');

end;

5: begin

acak:=0;

writeln;

writeln('Data pendaftar pada jurusan Pemasaran');

writeln('____________________________________________________________');

writeln('| No | No Daftar | Nama | Asal Sekolah | NEM |');

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

for i:=1 to n do

begin

if (a[i].jurusan=5) then

begin

inc(acak);

end;

writeln('|____|___________|______________|__________________|_______|');

writeln;

end;

write('Mau Filter lagi <y/t> ? ');readln(lagi);

end;

until (lagi<>'y');

end;

procedure sortir_nama(var a:larik_baru);

var backup:siswa;

begin

for i:=1 to n do copy[i]:=a[i];

for i:=1 to n-1 do

begin

for j:=i+1 to n do

begin

if (copy[i].nama>copy[j].nama) then

begin

backup:=copy[i];

copy[i]:=copy[j];

copy[j]:=backup;

end;

writeln('Data Pendaftar sesuai nama');

writeln;

cetak(copy);

end;

procedure sortir_nem(var a:larik_baru);

var backup:siswa;

jumlah:real;

begin

for i:=1 to n do copy[i]:=a[i];

for i:=1 to n-1 do

begin

for j:=i+1 to n do

begin

if (copy[i].nem<copy[j].nem) then

begin

backup:=copy[i];

copy[i]:=copy[j];

copy[j]:=backup;

end;

writeln('Data Pendaftar sesuai jumlah NEM');

writeln;

cetak(copy);

end;

procedure edit(var a:larik_baru);

var ganti:byte;

begin

write('Data yang akan diedit: ');readln(ganti);

writeln('Mengedit data ke ',ganti);

writeln;

write('Nama : ');readln(a[ganti].nama);

write('Tempat Tanggal Lahir : ');readln(a[ganti].ttl);

write('Alamat : ');readln(a[ganti].alamat);

write('Asal Sekolah : ');readln(a[ganti].asal);;

write('Alamat Sekolah : ');readln(a[ganti].alasal);

write('Jumlah NEM : ');readln(a[ganti].nem);

writeln;

writeln('Prestasi yang pernah diraih (0:Tidak, 1:Kabupaten, 2:Nasional, 3:Internasional)');

writeln('Hanya boleh melampirkan 1 prestasi');

write('Prestasi Anda? ');readln(a[ganti].prestasi);

writeln('Pilihan Jurusan:');

writeln(' 1. Teknik Jaringan (TKJ)');

writeln(' 2. Multimedia (MM)');

writeln(' 3. Akuntansi (AK)');

writeln(' 4. Administrasi Perkantoran (AP');

writeln(' 5. Pemasaran (PM)');

write('Pilihan Jurusan (1/2/3/4/5) : ');readln(a[ganti].jurusan);

writeln;

writeln('Pendaftar ke ',ganti,' sudah di edit');

end;

procedure hapus(var a:larik_baru);

var hilang:byte;

begin

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

for i:=hilang to n-1 do a[i]:=a[i+1];

dec(n);

writeln('Pendaftar ke ',hilang,' sudah di hapus');

end;

begin

repeat

begin

clrscr;

writeln(' ..::SELAMAT DATANG DI SMKN 1 BANTUL::..');

writeln(' Penerimaan Siswa Baru Tahun Ajaran 2013/2014');

writeln('_____________________________________________________');

writeln;

writeln('1. Daftar');

writeln('2. Tabel Pendaftar');

writeln('3. Cari Nama Pendaftar');

writeln('4. Daftar Perjurusan');

writeln('5. Sortir Nama Pendaftar');

writeln('6. Sortir Jumlah NEM');

writeln('7. Edit Data');

writeln('8. Hapus Data');

writeln('9. Selesai');

write('pilihan anda? ');readln(pil);

clrscr;

case pil of

1: daftar(sisba);

2: cetak(sisba);

3: cari(sisba);

4: fil_jur(sisba);

5: sortir_nama(sisba);

6: sortir_nem(sisba);

7: edit(sisba);

8: hapus(sisba);

9: begin

writeln;

writeln(' ..::Terima Kasih::.. ');

writeln(' Telah mendaftar di SMK N 1 Bantul ');

writeln('..Silahkan tunggu info selanjutnya..');

end;

readln;

end;

until (pil=9);

end.

Posted in pascal

3 komentar :

Akira17 Mei 2016 pukul 13.39
gabisa di run...
BalasHapus
Balasan
AP13 Juni 2017 pukul 07.15
Coba diteliti lagi indeksnya..
BalasHapus
Balasan
Unknown30 Agustus 2017 pukul 23.41
Kasih gambarannya dong
BalasHapus
Balasan

Tambahkan komentar

Langganan: Posting Komentar ( Atom )

Design by NewWpThemes | Blogger Theme by Lasantha - Premium Blogger Templates | NewBloggerThemes.com

TAYANGAN

coretan asti

man jadda wa jadda

25/11/13

Program Penerimaan Siswa Baru dengan Record pada Pascal

3 komentar :

Blog Archive

Popular Posts

PUSTAKA

Mengenai Saya

Pengikut

PENGUNJUNG