Function & IF

program Function_Pascal;
uses crt;

function harga(kode:string):real;
begin
if (kode='MLT30') then
harga:=115000000
else if(kode='MLT45') then
harga:=170000000
else if(kode='MLT54') then
harga:=225000000
else
harga:=0;
end;

function diskon(kode,jenis:string; harga:real):real;
begin
if (kode='MLT30') and (jenis='Tunai') then
diskon:= 0.2*harga
else if (kode='MLT45') and (jenis='Tunai') then
diskon:=0.15*harga
else if (kode='MLT54') and (jenis='Tunai') then
diskon:=0.1*harga
else
diskon:=0;
end;

function ppn(harga,diskon:real):real;
begin
ppn:=0.1*(harga-diskon);
end;

function total(harga,diskon,ppn:real):real;
begin
total:= harga-diskon+ppn;
end;


{Program Utama}
label lagi;
var
nama, kd_rmh, jns_beli:string;
hrg_rmh, disc, pajak, tot_bay:real;
jawab:char;
begin lagi:
clrscr;
write('Masukkan nama pembeli : ');readln(nama);
write('Masukkan kode rumah [MLT30/MLT45/MLT54] : ');readln(kd_rmh);
write('Masukkan jenis pembelian [Tunai/Kredit] : ');readln(jns_beli);
hrg_rmh:=harga(kd_rmh);
disc:=diskon(kd_rmh,jns_beli,hrg_rmh);
pajak:=ppn(hrg_rmh,disc);
tot_bay:=total(hrg_rmh,disc,pajak);
clrscr;
writeln(' Perumahan RSS ');
writeln('------------------------');
writeln('Nama pembeli : ', nama);
writeln('Harga rumah : ', hrg_rmh:0:0);
writeln('Diskon : ', disc:0:0);
writeln('PPn : ', pajak:0:0);
writeln('Total bayar : ', tot_bay:0:0);
readln;
write('Ingin input lagi [Y/T] : ');readln(jawab);
if jawab='Y' then goto lagi;
end.

Procedure Call By Reference-PerPusTakaaN

uses crt;
procedure buku(var kode:char;var jenis:string;var tarif:integer);
begin
if (kode='C') or (kode='c') then
begin
jenis:='Cerpen';
tarif:=500;
end
else
if (kode='K') or (kode='k') then
begin
jenis:='Komik';
tarif:=700;
end
else
if (kode='N') or (kode='n') then
begin
jenis:='Novel';
tarif:=1000;
end
else
begin
jenis:='Salah!!';
tarif:=0;
end;

end;

procedure hitung_totbay(var lama:byte;var tarif,totbay:integer);
begin
totbay:=lama*tarif;
end;

var
jenis:string;
nm,lagi,kode:char;
lama:byte;
tarif,totbay:integer;
label yana;
begin
yana:
clrscr;
write('Masukkan Nama Peminjam : ');readln(nm);
write('Masukkan Kode Buku [C/K/N] : ');readln(kode);
write('Masukkan Lama Pinjam : ');readln(lama);
clrscr;
writeln(' Perpustakaan Kecil-Kecilan ');
writeln;
buku(kode,jenis,tarif);
hitung_totbay(lama,tarif,totbay);
writeln('Jenis Buku : ',jenis);
writeln('Tarif Buku : ',tarif);
writeln('Nama Peminjam : ',nm);
writeln('Total Bayar : ',totbay);
writeln;
write('Input lagi [Y/T].. ?? ');readln(lagi);
if (lagi='Y') or (lagi='y') then
goto yana;

readln;
end.

Procedure Call By Reference

program prosedur_call_by_reference;

{*Procedure Utk Proses Hitung Nilai*}
uses crt;
procedure hitung_nilai(var tgs,aktif,ujian,akhir:real);
begin
akhir:=(tgs*0.3)+(0.3*aktif)+(0.4*ujian);
end;

{*Procedure Utk Hitung Grade*}
procedure hitung_grade(var grade:char;var akhir:real);
begin
if (akhir>=80) and (akhir<=100) then
grade:='A'
else
if (akhir>=69) and (akhir<=79) then
grade:='B'
else
if (akhir>=58) and (akhir<=68) then
grade:='C'
else
grade:='D';
end;

{*Program Utama*}
var
tgs1,aktif1,ujian1,akhir1:real;
nm,mata:string;
lagi,grade1:char;
label yana;
begin
clrscr;
yana:
write('Nama Siswa : ');readln(nm);
write('Mata Pelajaran : ');readln(mata);
write('Nilai Tugas : ');readln(tgs1);
write('Nilai KeAktifan : ');readln(aktif1);
write('Nilai Ujian : ');readln(ujian1);

clrscr;
hitung_nilai(tgs1,aktif1,ujian1,akhir1);
hitung_grade(grade1,akhir1);
writeln(' Lembaga Kursus "ILMU DUNIA" ');
writeln('__________________________________________');
writeln;
writeln('Siswa Yang Ternama : ',nm);
writeln('Mendapat Nilai Akhir sebesar : ',akhir1:2:2);
writeln('Pada Mata Pelajaran : ',mata);
writeln('Dengan Grade Nilai : ',grade1);
writeln;
writeln;
write(' Create By :: YaN@ ');
writeln;
writeln;

write('Hitung Lagi [Y/T] : ' );readln(lagi);
if (lagi='Y') or (lagi='y') then
goto yana;
readln;
end.

Konversi Suhu Celcius ke Fahrenheit & Reamur

--> Konversi Suhu Celcius ke Fahrenheit

Uses crt;
var f,c : real;
BEGIN
Writeln ('Program Konversi Celcius Ke Fahrenheit');
Writeln('------------------------------------------------');
Writeln; Write('Masukan Suhu dalam Celcius: ');
readln(c);
f:=(9/5)*c+32;
Writeln;
Writeln('Jadi Suhu Dalam Fahrenheit Adalah: ',f:4:2);
readln;
END.

-->Konversi Suhu Celcius ke Reamur

Uses crt;
var c,r : real;
BEGIN
Writeln('Program Konversi Celcius ke Reamur');
Writeln('-----------------------------------------------');
Writeln; Write('Masukan Suhu dalam Celcius: ');
readln(c);
r:=(4/5)*c;
Writeln;
Writeln('Jadi Suhu Dalam Reamur Adalah: ',r:4:2);
Readln;
END.

~ Pascal Array+Looping ~

program Array_looping;
uses crt;
label yana;
var tgs,mid,final,rata:array[1..5] of real;
data,y:integer;
lagi:char;

begin
yana:
clrscr;
writeln;
write('Masukkan Jumlah Data : ');readln(data);
writeln;
writeln('--- Data Nilai ---');

for y:=1 to data do
begin

write('Masukkan Nilai Tugas: ');readln(tgs[y]);
write('Masukkan Nilai MID : ');readln(mid[y]);
write('Masukkan Nilai Final: ');readln(final[y]);
writeln;

end;

clrscr;
writeln(' @@ Hasil Nilai @@');
writeln;
writeln('-----------------------------');
writeln(' No Nilai Rata');
writeln(' Tugas MID Final Rata');
writeln('-----------------------------');
writeln;
for y:=1 to data do
begin
gotoxy(1,wherey);write(y);
gotoxy(6,wherey);write(tgs[y]:2:0);
gotoxy(11,wherey);write(mid[y]:2:0);
gotoxy(16,wherey);write(final[y]:2:0);
rata[y]:=(tgs[y]+mid[y]+final[y])/3;
gotoxy(21,wherey);writeln(rata[y]:2:2);
end;
writeln;
write('Create: Y@na');
writeln;
writeln;
write('Input data lagi..?? ');readln(lagi);
if(lagi='Y') or (lagi='y') then
goto yana;
readln;
end.

By; YaNa