program bil_fibonacci;
uses wincrt;
const
n=10;
var
i, f, f1, f2: integer;
x: array[1..n] of integer;
begin
clrscr;
writeln('ingin mencetak bilangan fibonacci');
write('sampai suku ke - '); readln (x[i]);
writeln;
writeln('suku ke- 1= ',1);
writeln('suku ke- 2= ',1);
f1:= 1; f2:=1;
for i:=3 to n do
begin
f:=f1+f2;
writeln('suku ke-',i:2,'=',f:3);
f2:=f1; f1:=f;
end;
end.
program meghitungLuas;
uses crt;
var pil: char;
function LuasSegitiga(al, tg: integer): real;
begin
LuasSegitiga:=1/2*al*tg;
end;
function LuasSegiempat(p, l: integer): integer;
begin
LuasSegiempat:=p*l;
end;
procedure biodata;
begin writeln('============================');
writeln('NAMA = Noor fitriana Hastuti');
writeln('NIM = M0508059');
writeln('============================');
end;
procedure inputLuasSegitiga;
var al, tg: integer;
begin
writeln;
writeln('MENCARI LUAS SEGITIGA');
writeln;
write('MASUKKAN ALAS : '); readln(al);
write('MASUKKAN TINGGI : '); readln(tg);
write('LUAS SEGITIGA : ',LuasSegitiga(al,tg):3:1);
end;
procedure inputLuasSegiempat;
var p, l: integer;
begin
writeln;
writeln('MENCARI LUAS SEGIEMPAT');
writeln;
write('MASUKKAN PANJANG : '); readln(p);
write('MASUKKAN LEBAR : '); readln(l);
writeln;
write('LUAS SEGIEMPAT : ',LuasSegiempat(p,l));
end;
{===program utama===}
begin repeat
clrscr;
biodata;
writeln('MENU');
writeln;
writeln('1. LUAS SEGITIGA');
writeln('2. LUAS SEGIEMPAT');
writeln('3. EXIT');
writeln;
write('PILIHAN ANDA: '); readln(pil);
until (pil='1') or (pil='2') or (pil='3');
case pil of
'1': inputLuasSegitiga;
'2': inputLuasSegiempat;
'3': begin
clrscr;
readln;
end;
end;
readln;
end.
(*author: noor fitriana, s1 ilmu komputer UNS 2008*)
program palindrom;
uses wincrt;
var
x: integer;
teks, teks1, teks2 : string[10];
i: integer;
ul: char;
begin
repeat
write('MASUKAN TEKS YANG ANDA INGINKAN: '); readln(teks);
x:= length(teks);
for i:= 1 to x do
teks1:=teks1 + teks[i];
for i:=x downto 1 do
teks2:=teks2 + teks[i];
if teks1 = teks2 then
writeln('TEKS YANG ANDA MASUKAN TERMASUK PALINDROM')
else
writeln('TEKS YANG ANDA MASUKAN BUKAN PALINDROM');
write('MAU COBA LAGI? [Y/T]: '); readln(ul);
until upcase (ul)<>'Y';
readln;
end.
program mengonversi;
uses wincrt;
var
teks: string[10];
selisih, i, x: integer;
ul: char;
begin
clrscr;
repeat
write('MASUKAN TEKS YANG ANDA INGINKAN: '); readln(teks);
selisih:= ord('a')-ord('A');
x:=length(teks);
for i:= 1 to x do
begin
{SELISIH 'A' DAN 'a'=32}
if (teks[i]>='A') and (teks[i]<='Z') then
teks[i]:=chr(ord(teks[i])+selisih)
else
{selisih 'a' dan 'A'=32}
if (teks[i]>='a') and (teks[i]<='z') then
teks[i]:=chr(ord(teks[i])-selisih);
end;
writeln;
write('MEMBACA TEKS YANG TELAH ANDA MASUKAN: '); writeln(teks);
writeln;
write('MAU COBA LAGI? [Y/T]: '); readln(ul);
until upcase (ul)<>'Y';
readln;
end.
(*author: noor fitriana, s1 ilmu komputer UNS 2008*)
program EnkripDekrip;
uses wincrt;
var
teks:string[10];
x, y,i : integer;
ul: char;
begin
repeat
clrscr;
writeln('FITRI,MASUKAN TEKS YANG ANDA INGINKAN: '); readln(teks);
writeln;
repeat
writeln('PILIH TINGKATAN YANG ANDA INGINKAN(-5 sampai 5): '); readln(y);
until (y>=-5) and (y<=5);
writeln;
x:= length(teks);
for i:=1 to x do
begin
teks[i]:=chr(ord(teks[i])+y);
end;
writeln;
writeln('HASIL TEKS YANG TELAH DI ENKRIPSI: '); writeln(teks);
writeln;
for i:=1 to x do
begin
teks[i]:=chr(ord(teks[i])-y);
end;
writeln('Teks yang Telah di Enkripsi Akan di Kembalikan Lagi ke Semula atau di dekripsi');
writeln('HASIL TEKS YANG DI DEKRIPSI: '); writeln(teks);
write('MAU COBA LAGI? [Y/T]: '); readln(ul);
until upcase (ul)<>'Y';
readln;
end.
