1)Program urut;
uses crt;
var i,j,a:integer;
begin
for i := 1 to 5 do
begin
a := 1;
for j:= 1 to i do
begin
write(a,' ');
a := a + 2;
end;
writeln;
end;
readln;
end.
2)PROGRAM LOOPING;
USES CRT;
LABEL 10;
VAR I,c : INTEGER;
BIL1,BIL2 :INTEGER;
BEGIN
CLRSCR;
BIL1:=1; BIL2:=1;
write('Masukkan bilangan : ');readln(c);
FOR I :=1 TO c DO
BEGIN
WRITE(BIL1); BIL1 :=BIL1 + 2;
IF I = c THEN
BEGIN
WRITE(' =');
GOTO 10;
END;
IF I MOD 2= 1 THEN
BEGIN WRITE(' - ');BIL2:=BIL2 - BIL1;END
ELSE
BEGIN WRITE(' + '); BIL2:=BIL2+BIL1;END;
10: END;
WRITE (' ',BIL2);
READLN;
END.
3)Program keren;
uses crt;
type data = record
nama : string[20];
npm : string[8];
ket : string[6];
n1,n2,n3 : integer;
rat : real;
end;
var lucu : array[1..50]of data;
a,b,c : integer;
i : char;
procedure input;
begin
repeat
clrscr;
write('Jumlah data = ');readln(b);
for a := 1 to b do
begin
with lucu[a] do
begin
writeln('Jumlah = ',a);
write('Nama Mahasiswa : ');readln(nama);
write('N P M : ');readln(npm);
write('Nilai ke - 1 : ');readln(n1);
write('Nilai ke - 2 : ');readln(n2);
write('Nilai ke - 3 : ');readln(n3);
rat := (n1 + n2 + n3)/3;
writeln('Rata - rata = ',rat:0:0);
if rat >= 60 then
ket := 'Lulus' else
ket := 'gagal';
end;
end;
write('Data ada yang salah (y/t)? ');readln(i);
until (i='t') or (i='T')
end;
Procedure table;
begin
clrscr;
writeln(' ':25,'DAFTAR NILAI MAHASISWA');
writeln(' ':25,'----------------------');
writeln;
writeln('==============================================================================');
writeln(' No Nama Mahasiswa NPM Nilai1 Nilai2 Nilai3 Rata - rata Keterangan');
writeln('==============================================================================');
for a := 1 to b do
begin
with lucu[a] do
begin
writeln(a:3,nama:15,npm:9,n1:7,n2:7,n3:7,rat:10:0,ket:13);
end;
end;
writeln('==============================================================================');
readln;
end;
begin
input;
table;
end.
4)
program apotik;
uses crt;
const l = 'a01';
m = 'a02';
n = 'a03';
type pel = record
nama : string[17];
alamat : string[20];
obat : string[4];
jumlah,harga : integer;
end;
d_pel = file of pel;
var mn : array [1..100] of pel;
daf_pel : d_pel;
hari : string;
i,j,s : integer;
f : string;
k : char;
function garis (n,c : integer) : string;
var i : integer;
g : string;
begin
g := '';
for i := 1 to n do
g := concat(g,chr(c));
garis := g
end;
procedure input;
var c : integer;
begin
clrscr;
writeln('Apotik X Y Z');writeln;
writeln('Input transaksi');
write('Hari ini : ');readln(hari);
assign(daf_pel,hari);
rewrite(daf_pel);
clrscr;
write('Jumlah data : ');readln(s);
repeat
clrscr;
writeln(' ':13,'Apotik X Y Z');
writeln(' ':13,'Input data');writeln;
for i := 1 to s do
with mn[i] do
begin
writeln;
write('Supplier : ');readln(nama);
write('Alamat : ');readln(alamat);
write('Jenis Obat : ');readln(obat);
if obat = 'A01' then c := 1
else
if obat = l then c := 1
else
if obat = 'A02' then c := 2
else
if obat = m then c:= 2
else
if obat = 'A03' then c := 3
else
if obat = n then c := 3
else
c := 4;
case c of
1: harga := 6000;
2: harga := 7000;
3: harga := 5000;
4: f := 'Tidak ada.....'
end;
write('Jumlah : ');readln(jumlah);
end;
write('Akan mengisi data lagi ?(Y/T) : ');readln(k);
until not(k in['Y','y']);
write(daf_pel,mn[i]);
close(daf_pel)
end;
procedure baca;
var a : integer;
begin
clrscr;
assign(daf_pel,hari);
reset(daf_pel);
j := filesize(daf_pel);
writeln(' ':18,'APOTIK X Y Z');
writeln(' ':18,'------------');
writeln; writeln(garis(74,55));
write('| Supplier | Alamat | Obat |');
writeln(' Jumlah | Harga |');
writeln(garis(74,45));
read(daf_pel,mn[i]);
for i := 1 to s do
begin
with mn[i] do
begin
gotoxy(1,wherey); write('| ',nama);
gotoxy(19,wherey); write(' | ',alamat);
gotoxy(42,wherey); write('| ',obat);
gotoxy(49,wherey); write('| ',jumlah);
gotoxy(62,wherey); write('| ',harga,' |');
end;
writeln;
end;
writeln(garis(74,45));
readln;
close(daf_pel);
end;
begin
input;
baca;
end.
5)program baca_sector;
uses dos , crt;
const
jumlahtrack = 40;
readservice = 2;
type
buffer = array[1..5000] of char;
var
jmlsec,dskasl,nm_sc_awl : integer;
dskbuffer : buffer;
trck,side,i,bffrsz : integer;
procedure bacasector (side,trck,drive : integer;
var dskbuffer : buffer);
var
regs : registers;
begin
with regs do
begin
ax := (readservice shl 8) + jmlsec;
cx := (trck shl 8) + nm_sc_awl;
dx := (side shl 8) + drive;
es := seg (dskbuffer[1]);
bx := ofs (dskbuffer[1]);
intr ($13,regs);
for i := 1 to bffrsz do write(dskbuffer[1]);
end;
end;
begin
clrscr;
write('Mau baca disk pada drive apa ');
write('(0 = A, 1 = B, 2 = C, 3 = D, 4 = E, dst.) ?');readln(dskasl);
write('Side yang mana (0 atau 1) ?');readln(side);
write('Track ke berapa(0 - 39 or lebih) ?');readln(trck);
write('Mulai sector berapa (1 - 9 or lebih) ?');readln(nm_sc_awl);
write('Berapa sector yang mau di baca (1 - 9) ?');readln(jmlsec);
bffrsz := jmlsec*512;
bacasector (side,trck,dskasl,dskbuffer);
end.
6)Program hebat_sekali;
uses crt;
const jumlah_mk = 5;
type nama = string[15];
nilai = record
nama_mhs : string[17];
no_mhs : string[9];
nilai_ujian : array[1..jumlah_mk] of integer;
n_rata : real;
nilai_huruf : char
end;
d_nilai = file of nilai;
var daf_nilai : d_nilai;
pilihan : char;
nama_berkas : string;
function garis (n,c : integer) : string;
var i : integer;
g : string;
begin
g := '';
for i := 1 to n do
g := concat(g,chr(c));
garis := g
end;
procedure kotak (x1,y1,x2,y2,kode : integer);
var i : integer;
begin
gotoxy(x1,y1); writeln(chr(201),garis(x2-x1-1,205),chr(187));
gotoxy(x1,y2); writeln(chr(200),garis(x2-x1-1,205),chr(188));
for i := y1+1 to y2-1 do
begin
gotoxy(x1,i); writeln(chr(186));
gotoxy(x2,i); writeln(chr(186))
end;
if kode in [1..2] then
begin
gotoxy(1,5); writeln(chr(199),garis(76,196),chr(182))
end;
if kode = 2 then
begin
gotoxy(1,3); writeln(chr(199),garis(76,196),chr(182));
gotoxy(1,7); writeln(chr(199),garis(76,196),chr(182));
gotoxy(1,21); writeln(chr(199),garis(76,196),chr(182));
end
end;
function menu : char;
var p : char;
begin
clrscr;
kotak(1,1,78,23,1);
gotoxy(30,3); writeln('DAFTAR MENU PILIHAN');
gotoxy(20,8); writeln('A. MEMILIH BERKAS YANG AKAN DI OPERASIKAN');
gotoxy(20,9); writeln('B. MEMASUKKAN DATA');
gotoxy(20,10); writeln('C. MEMBETULKAN DATA');
gotoxy(20,11); writeln('D. MENYISIPKAN RECORD');
gotoxy(20,12); writeln('E. MENGHAPUS RECORD');
gotoxy(20,13); writeln('F. MELIHAT ISI BERKAS');
gotoxy(20,15); writeln('G. SELESAI');
gotoxy(1,18); writeln(chr(199),garis(76,196),chr(182));
repeat
gotoxy(48,20); writeln(' ':10);
gotoxy(30,20); write('PILIH SALAH SATU: ');
p := upcase(readkey)
until p in ['A'..'G'];
menu := p
end;
procedure pilih_berkas (var bks : d_nilai; var nb : string);
var n_bks : string;
baru : char;
cek,b_baru : boolean;
function berkas_ada (nb:string) : boolean;
var b : d_nilai;
begin
assign(b,nb);
{$i-}
reset(b);
{$i+}
berkas_ada := (ioresult = 0)
end;
begin
b_baru := false; cek := true;
while cek do
begin
clrscr;
kotak(1,1,78,23,1);
gotoxy(22,3); writeln('MEMILIH BERKAS YANG AKAN DI OPERASIKAN');
kotak(18,10,62,17,0);
gotoxy(20,12); write('Isikan nama berkas :.........');
gotoxy(40,12);readln(nb);
if not berkas_ada(nb) then
begin
b_baru := true;
gotoxy(20,14); writeln('Berkas di atas tidak ada');
gotoxy(20,15); write('Apakah ini berkas baru ?');
write(' <Y>a/<T>idak : '); baru := upcase(readkey);
if baru <> 'Y' then
cek := true
else
cek := false
end
else
begin
cek := false;b_baru := false
end;
end;
assign(bks,nb);
if b_baru then rewrite(bks)
else reset(bks)
end;
procedure data (var nm : nilai; x1,y1 : integer);
var i : integer;
begin
with nm do
begin
n_rata := 0.0;
gotoxy(x1,y1); write('Nama Mahasiswa : ');readln(nama_mhs);
gotoxy(x1,wherey); write('Nomor Mahasiswa : '); readln(no_mhs);
for i := 1 to jumlah_mk do
begin
gotoxy(x1,wherey); write('Nilai ke ',i:2,' : ');
readln(Nilai_ujian[i]);
n_rata := n_rata + nilai_ujian[i]
end;
n_rata := n_rata/jumlah_mk
end;
end;
Procedure cetak_rekaman(rek : nilai; x1,y1 : integer );
var i : integer;
begin
with rek do
begin
gotoxy(x1,y1); writeln('Nama Mahasiswa : ',nama_mhs);
gotoxy(x1,wherey); writeln('Nomor Mahasiswa : ',no_mhs);
for i:= 1 to jumlah_mk do
begin
gotoxy(x1,wherey);
writeln('Nilai ke ',i:2,' : ',nilai_ujian[i])
end
end
end;
Procedure konversi_nilai (var bks : d_nilai);
var nilai_mhs : nilai;
i,j,n : integer;
sd,rata,b1,b2,b3,b4 : real;
begin
n := filesize(bks); seek(bks,0);
rata := 0.0;
for i := 0 to n-1 do
begin
read(bks,nilai_mhs);
rata := rata + nilai_mhs.n_rata
end;
rata := rata/n;
sd := 0.0;
seek(bks,0);
for i := 1 to n-1 do
begin
read(bks,nilai_mhs);
sd := sd + sqr(nilai_mhs.n_rata-rata);
end;
sd := sqrt(sd/(n-1));
b1 := rata + 1.5 * sd; b2 := rata + 0.5 * sd;
b3 := rata - 0.5 * sd; b4 := rata - 1.5 * sd;
seek(bks,0);
for i := 0 to n-1 do
begin
read(bks,nilai_mhs);
with nilai_mhs do
if n_rata >= b1 then nilai_huruf := 'A'
else if (n_rata<b1) and (n_rata>=b2) then nilai_huruf := 'B'
else if (n_rata<b2) and (n_rata>=b3) then nilai_huruf := 'C'
else if (n_rata<b3) and (n_rata>=b4) then nilai_huruf := 'D'
else nilai_huruf := 'E';
seek(bks,i);
write(bks,nilai_mhs)
end;
end;
procedure isi_data (var bks : d_nilai; nb : string);
var nilai_mhs : nilai;
i,n,j : integer;
lagi : char;
begin
n := filesize(bks);
seek(bks,n);
repeat
clrscr;
kotak(1,1,78,23,2);
gotoxy(19,2); writeln('MENGISI DATA DAN MENYIMPAN KE DALAM BERKAS');
gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'". ');
writeln('SEKARANG BERISI: ',n:3,'RECORD');
gotoxy(21,6); writeln('SEKARANG MENGISI RECORD KE : ',n+1:3);
data(nilai_mhs,20,9);
write(bks,nilai_mhs);
inc(n);
gotoxy(20,22); write('Akan mengisi lagi? <Y>a/<T>idak: ');
readln(lagi); lagi := upcase(lagi);
until lagi <> 'Y' ;
clrscr;
kotak(1,1,78,23,0);
kotak(17,10,62,14,0);
gotoxy(19,12); write('Tunggu sebentar, sedang e..e.. nich');
konversi_nilai(bks);
end;
procedure edit_data (var bks : d_nilai; nb :string);
var nm : nilai;
n,i,j : integer;
sb : char;
nomor : string[9];
ada : boolean;
procedure cek (var ada : boolean; var i : integer; no : string);
begin
i := 0; ada := false;
seek(bks,i);
repeat
read(bks,nm);
if no = nm.no_mhs then ada := true
else
begin
inc(i);
if i < n then seek(bks,i)
end
until (i = n) or ada
end;
begin
n := filesize(bks);
repeat;
clrscr;
kotak(1,1,78,23,2);
gotoxy(25,2); writeln('PROSES MEMBETULKAN ISI RECORD');
gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
writeln(', SEKARANG BERISI: ',n:3,' RECORD');
repeat
gotoxy(50,6); writeln(' ':10);
gotoxy(26,6); write('ISIKAN NOMOR MAHASISWA: ');
readln(nomor);
cek(ada,i,nomor);
until ada;
gotoxy(20,6); writeln(' ':55);
seek(bks,i); read(bks,nm);
for j := 6 to 20 do
begin
gotoxy(39,j); writeln(chr(179));
end;
gotoxy(39,5); writeln(chr(194)); gotoxy(39,21); writeln(chr(193));
gotoxy(10,6); writeln('ISI RECORD KE: ',i+1:3);
gotoxy(42,6); writeln('ISIKAN DATA PEMBETULAN DI BAWAH INI');
gotoxy(1,7);
writeln(chr(199),garis(37,196),chr(197),garis(38,196),chr(182));
cetak_rekaman(nm,3,8); data(nm,41,8);
repeat
gotoxy(26,22); write('<S>impan/<B>atalkan: ');
sb := upcase(readkey)
until sb in ['S','B','s','b'];
gotoxy(20,22); writeln(' ':55);
if sb = 'S' then
begin
seek(bks,i);
write(bks,nm)
end;
gotoxy(20,22); write('Akan membetulkan lagi? <Y>a/<T>idak: ');
sb := upcase(readkey)
until sb <> 'Y';
konversi_nilai(bks)
end;
procedure sisip_rekaman (var bks : d_nilai; nb : string);
var rek_baru,rb : nilai;
i,j,k,n : integer;
lagi : char;
begin
n := filesize(bks);
repeat
clrscr;
kotak(1,1,78,23,2);
gotoxy(28,2); writeln('MENYISIPKAN RECORD BARU');
gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
writeln(', SEKARANG BERISI: ',n:3,'RECORD'); gotoxy(13,6);
writeln('Record baru akan ditempatkan sebagai record nomor: ');
repeat
gotoxy(68,6); write(' ':5);
gotoxy(68,6); readln(k);
until k in [1..n+1];
data(rek_baru,20,9);
if k = n+1 then
begin
seek(bks,n);
write(bks,rek_baru)
end
else
begin
for j := n-1 downto k-1 do
begin
seek(bks,j);
read(bks,rb); write(bks,rb);
end;
seek(bks,k-1); write(bks,rek_baru)
end;
inc(n);
gotoxy(20,22); write('Akan menyisipkan lagi? <Y>a/<T>idak: ');
until upcase(readkey) <> 'Y';
konversi_nilai(bks)
end;
procedure hapus_rekaman (var bks : d_nilai; nb : string);
var nm : nilai;
bb : d_nilai;
i,j,n : integer;
b1 : string;
hapus : char;
procedure pindahkan;
begin
read(bks,nm);
write(bb,nm);
end;
begin
repeat;
clrscr;
n := filesize(bks);
kotak(1,1,78,23,2);
gotoxy(23,2); writeln('MENGHAPUS RECORD DARI DALAM BERKAS');
gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
writeln('SEKARANG BERISI: ',n:3,' RECORD');
gotoxy(24,6); write('Akan menghapus record nomor: ');
repeat
gotoxy(54,6); write(' ':5);
gotoxy(54,6); readln(i);
until i in [1..n];
gotoxy(20,6); writeln(' ':50);
gotoxy(28,6); writeln('ISI RECORD NOMOR: ',i:3);
seek(bks,i-1); read(bks,nm); writeln;
cetak_rekaman(nm,23,9);
gotoxy(25,22); write('Jadi di hapus? <Y>a/<T>idak: ');
if upcase(readkey) = 'Y' then
begin
gotoxy(19,22);
write('TUNGGU SEBENTAR, SEDANG E..E.. NICH');
assign(bb,'BUFFER'); rewrite(bb);
if i = 1 then
begin
seek(bks,1);
for j := 1 to n-1 do
pindahkan
end
else if i = n then
begin
seek(bks,0);
for j := 0 to n-2 do
pindahkan
end
else
begin
seek(bks,0);
for j := 0 to n-1 do
if j <> i-1 then pindahkan
else seek(bks,i)
end;
close(bks); close(bb);
erase(bks); rename(bb,nb);
assign(bks,nb); reset(bks)
end;
gotoxy(10,22); writeln(' ':65);
gotoxy(23,22); write('Akan menghapus lagi? <Y>a/<T>idak: ');
until upcase(readkey) <> 'Y';
konversi_nilai(bks)
end;
procedure cetak_nilai (var bks : d_nilai);
var nilai_mhs : nilai;
i,j,n : integer;
c : char;
begin
n := filesize(bks); seek(bks,0);
clrscr;
writeln(' ':18,'DAFTAR NILAI UJIAN "PEMROGRAMAN PASCAL"');
writeln(' ':18,garis(39,45));
writeln; writeln(garis(74,55));
write('| No | Nama Mahasiswa | NO Mhs | N1 |');
writeln(' N2 | N3 | N4 | N5 | Rata2 | Nilai |');
writeln(garis(74,45));
for j := 1 to n do
begin
read(bks,nilai_mhs);
with nilai_mhs do
begin
gotoxy(1,wherey); write('| ',j:2,' | ',nama_mhs);
gotoxy(23,wherey); write(' | ',no_mhs:5,' | ');
for i := 1 to jumlah_mk do
begin
gotoxy(35+5*(i-1),wherey); write(nilai_ujian[i]:2,' | ')
end;
gotoxy(60,wherey);
writeln(n_rata:5:2,' | ',nilai_huruf,' |')
end
end;
writeln(garis(74,45));
gotoxy(20,23); write('TEKAN <RETURN> UNTUK MENERUSKAN...');
c := readkey
end;
procedure selesai (var bks : d_nilai);
begin
close(bks);
clrscr;
kotak(1,1,78,23,0);
gotoxy(23,11); writeln('TERIMA KASIH ATAS KEPERCAYAAN ANDA');
gotoxy(23,12); writeln(' MENGGUNAKAN PROGRAM INI');
gotoxy(23,13); writeln(' SELAMAT BELAJAR, SUKSES SELALU');
gotoxy(23,16); writeln(' sanijiro',chr(3),chr(3),' si kaki angin');
kotak(20,9,60,15,0)
end;
begin
repeat
clrscr; pilihan := menu;
case pilihan of
'A' : pilih_berkas(daf_nilai,nama_berkas);
'B' : isi_data(daf_nilai,nama_berkas);
'C' : edit_data(daf_nilai,nama_berkas);
'D' : sisip_rekaman(daf_nilai,nama_berkas);
'E' : hapus_rekaman(daf_nilai,nama_berkas);
'F' : cetak_nilai(daf_nilai);
'G' : selesai(daf_nilai)
end;
until pilihan = 'G'
end.
7)program pegawai;
uses crt;
type pegawai = record
nama : string[20];
nomor,status : string[5];
pokok,tunj : longint;
lembur,total,jam : longint;
end;
var cek,kode : char;
datain : array[1..50] of pegawai;
n,i : integer;
respon : boolean;
jumlah : longint;
procedure garis(x1,x2,y1 : integer;str : string);
var n,i : integer;
begin
n := x2-x1;
for i := 0 to n-1 do
begin
gotoxy(x1+i,y1);write(str);
end;
end;
procedure writexy(x,y : integer; str : string);
begin
gotoxy(x,y);write(str);
end;
function allcaps (str : string) : string;
var x : integer;
begin
for x := 1 to length(str) do
str[x] := upcase(str[x]);
allcaps := str;
end;
procedure input;
begin
textcolor(cyan);
i := 1;
repeat
with datain[i] do
begin
clrscr;
writexy(10,5,'PT. Extreme');
writexy(10,6,'Jakarta');
garis(4,78,7,#205);
gotoxy(60,8);writeln('Data ke- ',i);
inc(i);
writexy(10,9,'Nama : ');readln(nama);
nama := allcaps(nama);
repeat
writexy(10,10,'NIP : ');readln(nomor);
nomor := allcaps(nomor);
if nomor[1] = 'A' then kode := '1'
else if nomor[1] = 'B' then kode := '2';
case kode of
'1' :
begin
status := 'Tetap';
pokok := 350000;
tunj := 400000;
end;
'2' :
begin
status := 'Honor';
pokok := 250000;
tunj := 200000;
end;
end;
until (kode = '1') or (kode = '2');
gotoxy(10,11);writeln('Status : ',status);
gotoxy(10,12);writeln('Gaji pokok : ',pokok);
gotoxy(10,13);writeln('Tunjangan : ',tunj);
repeat
writexy(10,14,'Jam lembur : ');readln(jam);
until jam < 10;
lembur := 15000 * jam;
total := pokok + tunj + lembur;
jumlah := total + jumlah;
end;
repeat
writexy(33,24,'Masukkan data lagi (y/t) : ');
cek := readkey; cek := upcase(cek);
until (cek = 'Y') or (cek = 'T');
case cek of
'Y': respon := true;
'T': respon := false;
end;
until not respon;
end;
procedure tampil;
begin
clrscr;
textcolor(cyan);
writexy(10,2,'PT. Extreme');
writexy(10,3,'Daftar Pegawai');
garis(4,80,4,#196);
writexy(5,5,'Nama');
writexy(19,5,'NIP');
writexy(27,5,'Status');
writexy(38,5,'Gaji');
writexy(47,5,'Tunjangan');
writexy(61,5,'Lembur');
writexy(74,5,'Total');
for n := 1 to i-1 do
begin
with datain[n] do
begin
writexy(5,6+n,nama);
gotoxy(18,6+n);write(nomor);
gotoxy(27,6+n);write(status);
gotoxy(33,6+n);write(pokok:10);
gotoxy(45,6+n);write(tunj:10);
gotoxy(57,6+n);write(lembur:10);
gotoxy(70,6+n);write(total:10);
end;
end;
garis(4,80,6,#205);
garis(4,80,wherey+i,#196);
end;
begin
textbackground(black);
clrscr;
repeat
begin
clrscr;
input;
tampil;
writexy(61,wherey+1,'Jumlah = ');
gotoxy(70,wherey);write(jumlah:10);
repeat
begin
writexy(35,24,'Input Lagi (y/t) : ');
cek := readkey; cek := upcase(cek);
end;
until (cek = 'Y') or (cek = 'T');
case cek of
'Y': respon := true;
'T': respon := false;
end;
end;
until not respon;
end.
8)program peg2;
uses crt;
const tot_minggu = 25;
tot_bulan = 100;
harga_jam = 2000;
line = '-------------------------------------------------------------------------------';
type status = (e,p,d);
gaji = record
nama : string[5];
id : string[3];
dept : string[5];
case st : status of
e : (sal,sal1,tot_work,tot_ot,tot,allow : longint);
p : (sal_hour2,total_work2,total_ot,tot2,sal2 : longint; allow2 : char);
d : (sal_hour3,total_work3,sal3 : longint; allow3,tot3 : char);
end;
tot_emp = 1..50;
table = array[tot_emp] of gaji;
var tabel_salary : table;
total : tot_emp;
procedure input(var tab : table;n : tot_emp);
var i,ij : byte;
code : char;
begin
for i := 1 to n do
with tab[i] do
begin
writeln;
writeln(' ':5,i:2,'# record data');
writeln('-------------------------');writeln;
write('Nama : ');readln(nama);
write('No. Id : ');readln(id);
write('Divisi : ');readln(dept);
for ij := 1 to length(nama) do
nama[ij] := upcase(nama[ij]);
for ij := 1 to length(id) do
id[ij] := upcase(id[ij]);
for ij := 1 to length(dept) do
dept[ij] := upcase(dept[ij]);
repeat
write('Status pegawai [A/B/C] : ');readln(code);
code := upcase(code);
gotoxy(wherex+33,wherey-1);
until code in ['A','B','C'];
case code of
'A' : begin
writeln('Peg. tetap');
st := e;
write('Waktu kerja sebulan : ');readln(tot_work);
write('Gaji sebulan : ');readln(sal1);
end;
'B' : begin
writeln('Peg. sementara');
st := p;
write('Gaji per-jam : ');readln(sal_hour2);
write('Waktu kerja seminggu : ');readln(total_work2);
end;
'C' : begin
writeln('Pekerja harian');
st := d;
write('Bayaran per-jam : ');readln(sal_hour3);
write('Waktu kerja per-hari : ');readln(total_work3);
end;
end;
end;
end;
procedure hitung(var tab : table;n : tot_emp);
var i : byte;
begin
for i := 1 to total do
with tab[i] do
begin
case st of
e : begin
allow := 500000;
if (tot_work > tot_bulan) then
begin
tot_ot := tot_work - tot_bulan;
tot := tot_ot * harga_jam;
sal := sal1 + tot + 500000;
end
else
begin
tot := 0;
sal := sal1 + 500000;
end;
end;
p : begin
allow2 := '-';
if (total_work2 > tot_minggu) then
begin
total_ot := total_work2 - tot_minggu;
tot2 := total_ot * harga_jam;
sal2 := tot_minggu * sal_hour2 + tot2;
end
else
begin
tot2 := 0;
sal2 := total_work2 * sal_hour2;
end;
end;
d : begin
allow3 := '-';
tot3 := '-';
sal3 := total_work3 * sal_hour3;
end;
end;
end;
end;
procedure cetak;
var i : byte;
begin
clrscr;
writeln(' ':15,'Daftar Karyawan PT. Mobisel Jakarta');
writeln(' ':15,'-----------------------------------');writeln;
writeln('No. Name Id.Num. Div. Status Overtime Allowance Total Salary');
writeln('-------------------------------------------------------------------------');
for i := 1 to total do
with tabel_salary[i] do
begin
gotoxy(1,i+5);write(i);
gotoxy(5,i+5);write(nama);
gotoxy(11,i+5);write(id);
gotoxy(20,i+5);write(dept);
gotoxy(27,i+5);
case st of
e : begin
write('Peg. tetap',' ':5,tot);
gotoxy(51,i+5);write(allow);
gotoxy(62,i+5);write(sal);
end;
p : begin
write('Peg. sementara',' ':2,tot2);
gotoxy(51,i+5);write(allow2);
gotoxy(62,i+5);write(sal2);
end;
d : begin
write('Peg. harian',' ':6,tot3);
gotoxy(51,i+5);write(allow3);
gotoxy(62,i+5);write(sal3);
end;
end;
end;
writeln;write(line);
end;
begin
clrscr;
writeln('Input data pegawai');
writeln('------------------');
write('Total pegawai : ');readln(total);
input(tabel_salary,total);
hitung(tabel_salary,total);
cetak;
end.
