Contoh RECORD pemograman pascal

CONTOH RECORD 
program contoh_record_kelasA;
uses wincrt;

type karyawan=record
     nik,nama:string;
     gol:1..3;
     status:1..2;
     gaji:real;
     end;
     larik_kar=array[1..20] of karyawan;

var kar:larik_kar;
    i,n:byte;
    pil:1..8;

function hitung_gaji(a:byte;b:byte):real;
var pokok:longint;
begin
pokok:=500000;
if (b=0) and (a=1) then hitung_gaji:= pokok+0.1*pokok else
if (b=1) and (a=1) then hitung_gaji:= pokok+0.25*pokok else
if (b=0) and (a=2) then hitung_gaji:=(pokok*1.5)+(0.1*pokok) else
if (b=1) and (a=2) then hitung_gaji:=(pokok*1.5)+(0.25*pokok) else
if (b=0) and (a=3) then hitung_gaji:=(pokok*2.5)+(0.1*pokok) else
hitung_gaji:= (pokok+2.5) +(0.25*pokok);
end;                                                                                

procedure isi_data(var x:larik_kar);
var lagi:char;
begin
repeat
begin
     inc(n);
     writeln(' mengisi data kearyawan record ke ',n);
     write(' masukann nik             ==> ');readln(x[n].nik);
     write(' masukan nama             ==> ');readln(x[n].nama);
     write(' masukan gol (1-3)        ==> ');readln(x[n].gol);
     write(' masukan status 1=menikah,0=tidak==> ');readln(x[n].status);
     x[n].gaji:=hitung_gaji(x[n].gol,x[n].status);
     writeln;write(' mau isi lagi <y/t> ? ');readln(lagi);
     end
     until (lagi<>'y');
     end;
procedure cetak (var x:larik_kar);
var bantu1,bantu2:string;

begin
writeln('       DATA KARYAWAN PT MAJU TERUS TH 2012 ');
writeln('-------------------------------------------------------------');
writeln('NO  NIK    NAMA               GOL       STATUS          GAJI');
writeln('=============================================================');
for i:=1 to n do
begin
     with x[i] do
     begin
     if (x[i].gol=1) then bantu1:='office boy' else if (x[i].gol=2) then
     bantu1:= 'supervisor' else bantu1:= 'manajer';
     if (x[i].status=0) then bantu2:='tidak menikah' else bantu2:='menikah';
     writeln(i:2,' ',nik:4,'  ',nama:13,'  ',bantu1:12,'  ',bantu2:14,'  ','Rp',gaji:10:2);
     end;
     end;
     writeln('=============================================================');
     end;

procedure filter_gol(var x:larik_kar);
var pil_gol:1..3;
begin
writeln;writeln('pilih golongan yg di filter');
writeln('1. gol 3 (manajer) ');
writeln('2. gol 2 (supervisor) ');
writeln('3. gol 1 (office boy) ');
write('pilihan anda==> ');readln(pil_gol);
if (pil_gol=3) then
begin
writeln('ini adalah golongan para manajer');
for i:=1 to n do
if (x[i].gol=3) then writeln(i:2,'  ',x[i].nik:6,'  ',x[i].nama:15);
end
else
    if (pil_gol=2) then
begin
writeln('ini adalah golongan para supervisor');
for i:=1 to n do
if (x[i].gol=2) then writeln(i:2,'  ',x[i].nik:6,'  ',x[i].nama:15);
end
else
begin
writeln('ini adalah golongan para office boy');
for i:=1 to n do
if (x[i].gol=1) then writeln(i:2,'  ',x[i].nik:6,'  ',x[i].nama:15);
end;
end;

procedure hapus(var x:larik_kar);
var rec_hapus:byte;
begin
     write(' record nomer berapa yg akan di hapus ');readln(rec_hapus);
     for i:=rec_hapus to (n-1) do x[i]:=x[i+1];  {mngeser posisi record dri rec terpilih}
     dec(n); {menghapus rec_terakir}
     write('record no ',rec_hapus,' sudah di hapus');
     end;

{program utama}
begin
repeat
begin
     clrscr;
     writeln('  PENGOLAHAN DATA KARYAWAN PT MAJU TERUS ');
     writeln('1.isi/tambah data karyawan');
     writeln('2.cetak data karyawan');
     writeln('3.filtering berdasar gaji');
     writeln('4.filtering berdasarkan golongan');
     writeln('5.mencarin karyawan tertentu');
     writeln('6.edit data karyawan');
     writeln('7.menghapus karyawan berdasar no record');
     writeln('8.selesai');
     writeln;
     write('masukan pilihan anda <1-8> ==> ');readln(pil);
     case pil of
     1:isi_data(kar);
     2:cetak(kar);
     {3:filter_gaji(kar);}
     4:filter_gol(kar);
     {5:cari_kar (kar);
     6:edit_kar (kar);}
     7:hapus(kar);
     8:writeln ('TERIMA KASIH TELAH MENCOBA PROGRAM INI');
     end; {case}
     readln;
     end {repeat}
     until (pil=8);
     end.