Uses wincrt;
var
nama : string;
i,jd : byte;
kode,judul:array [1..50] of string;
hrg,jml,total:array [1..50] of real;
tbyr:real;
{prosedure data buku}
procedure data_buku;
begin
write('Nama pembeli :');readln(nama);
write('Masukkan jumlah data :');readln(jd);
for i := 1 to jd do
begin
writeln('Data pembeli ke :',i);
write('Masukkankode buku :');readln(kode[i]);
if kode [i]='A' then
begin
judul[i]:='TURBO PASKAL';
hrg[i]:=20000;
end
else
if kode[i]='B' then
begin
judul[i]:='VISUAL BASIC';
hrg[i]:=40000;
end
else
if kode[i]='C' then
begin
judul[i]:='BORLAN DELPI';
hrg[i]:=30000;
end
else
if kode[i]='D' then
begin
judul[i]:='DESIGN WEB ';
hrg[i]:=30000;
end
else
if kode[i]='E' then
begin
judul[i]:='BUKU KIMIA ';
hrg[i]:=30000;
end
else
begin
judul[i]:='BUKU PROGRAM';
hrg[i]:=50000;
end;
writeln('Judul buku :',judul[i]);
writeln('Harga :',hrg[i]:2:0);
write('masukkan jumlah beli :');readln(jml[i]);
writeln;
end;
end;
{prosedure tabel}
procedure tabel;
begin
CLRSCR;
writeln('***********************************************');
writeln(' TOKO BUKU "YUDA PRATAMA DROID"');
WRITELN(' Jl, Optimus 2X No:189 Tlp:(0411)000111');
WRITELN(' E-mail: yuda_pratama@y7mail.com / www.yudapratamadroid.co.cc');
writeln('***********************************************');
writeln(' Nama Pembeli :',nama);
writeln('========================================================================= ');
writeln(' No KODE JUDUL HARGA JUMLAH TOTAL');
WRITELN(' BUKU BUKU BELI BUKU HARGA');
writeln('=========================================================================');
tbyr:=0;
for i:=1 to jd do
begin
total[i]:=hrg[i]*jml[i];
tbyr:=total[i]+tbyr;
end;
for i:=1 to jd do
begin
writeln(i:2,kode[i]:5,judul[i]:19,hrg[i]:14:0,jml[i]:12:0,total[i]:17:0);
END;
writeln('=========================================================================');
writeln(' TOTAL BAYAR = Rp', tbyr :2:0);
END;
{PROGRAM UTAMA}
VAR
lagi : char;
label awal,akhir;
begin
awal:
clrscr;
Data_buku;
tabel;
write(' input data lagi? [y/t]'); readln(lagi);
if (lagi='y') or (lagi='y') then
goto awal
else
goto akhir;
akhir:
readln;
end.
Selasa, 08 Juni 2010
Program Persegi Panjang pada Turbo Pascal
program persegi_panjang;
uses wincrt;
var
p,l:byte;
luas,keliling:integer;
procedure hitung_luas;
begin
luas:=p*l;
writeln('luas : ',luas);
end;
procedure hitung_keliling;
begin
keliling:=(2*p)+(2*l);
writeln('keliling : ',keliling);
end;
begin
clrscr;
writeln('=========================================================');
writeln('program untuk menghitung luas dan keliling persg pnjng :');
writeln('=========================================================');
writeln;
write('masukkan panjang :');readln(p);
write('masukkan lebar :');readln(l);
writeln;
hitung_luas;
hitung_keliling;
readkey;
end.
uses wincrt;
var
p,l:byte;
luas,keliling:integer;
procedure hitung_luas;
begin
luas:=p*l;
writeln('luas : ',luas);
end;
procedure hitung_keliling;
begin
keliling:=(2*p)+(2*l);
writeln('keliling : ',keliling);
end;
begin
clrscr;
writeln('=========================================================');
writeln('program untuk menghitung luas dan keliling persg pnjng :');
writeln('=========================================================');
writeln;
write('masukkan panjang :');readln(p);
write('masukkan lebar :');readln(l);
writeln;
hitung_luas;
hitung_keliling;
readkey;
end.
Program Input Nilai Mahasiswa pada Turbo Pascal
program inputnilaimhs;
uses wincrt;
const
garis='---------------------------------------------------------------------------';
var
nil1,nil2,nil3,nil4,nil5:array[1..10] of 0..100;
nim:array[1..10] of string [20];
NAMA:ARRAY[1..10] OF STRING [20];
n,i,bar:integer;
jum:real;
tl:char;
begin
clrscr;
{ pemasukan data dalam array }
writeln('maximize dulu windows anda,');writeln('untuk mendapat hasil yang maximal!!!!');
write('berapa data mahasiswa yang akan di input :');
readln
(n);
for i := 1 to n do
begin
clrscr;
gotoxy(30,4+1);write('data ke-:',i:2);
gotoxy(11,5+i);write('nim :');readln(nim[i]);
gotoxy(11,6+i);write('nama :');readln(nama[i]);
gotoxy(11,7+i);write('nilai 1 :');readln(nil1[i]);
gotoxy(11,8+i);write('nilai 2 :');readln(nil2[i]);
gotoxy(11,9+i);write('nilai 3 :');readln(nil3[i]);
gotoxy(11,10+i);write('nilai 4 :');readln(nil4[i]);
gotoxy(11,11+i);write('nilai 5 :');readln(nil5[i]);
end;
{ proses data dalam array }
clrscr;
gotoxy(5,4);write(garis);
gotoxy(5,5);write('no');
gotoxy(9,5);write('nim');
gotoxy(18,5);write('nama');
gotoxy(28,5);write('nilai1');
gotoxy(37,5);write('nnil2');
gotoxy(45,5);write('nil3');
gotoxy(53,5);write('nil4');
gotoxy(61,5);write('nil5');
gotoxy(69,5);write('rata');
gotoxy(75,5);write('abjad');
gotoxy(5,6);write(garis);
{ proses cetak isi array dan seleksi kondisi }
bar :=7;
for i:=1 to n do
begin
jum:=(nil1[i]+nil2[i]+nil3[i]+nil4[i]+nil5[i])/5;
if
jum=100 then tl:='A'
ELSE
IF JUM>80 THEN TL:='B'
ELSE
IF JUM>60 THEN TL:='C'
ELSE
IF JUM>50 THEN TL:='D'
else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyelesaian kondisi }
gotoxy(5,bar);writeln(i:2);
gotoxy(9,bar);writeln(nim[i]);
gotoxy(18,bar);writeln(nama[i]);
gotoxy(28,bar);writeln(nil1[i]:4);
gotoxy(37,bar);writeln(nil2[i]:4);
gotoxy(45,bar);writeln(nil3[i]:4);
gotoxy(53,bar);writeln(nil4[i]:4);
gotoxy(61,bar);writeln(nil5[i]:4);
gotoxy(69,bar);writeln(jum:5:1);
gotoxy(77,bar);writeln(tl);
bar:=bar+1;
end;
gotoxy(5,bar+1);writeln(garis);
readln;
end.
uses wincrt;
const
garis='---------------------------------------------------------------------------';
var
nil1,nil2,nil3,nil4,nil5:array[1..10] of 0..100;
nim:array[1..10] of string [20];
NAMA:ARRAY[1..10] OF STRING [20];
n,i,bar:integer;
jum:real;
tl:char;
begin
clrscr;
{ pemasukan data dalam array }
writeln('maximize dulu windows anda,');writeln('untuk mendapat hasil yang maximal!!!!');
write('berapa data mahasiswa yang akan di input :');
readln
(n);
for i := 1 to n do
begin
clrscr;
gotoxy(30,4+1);write('data ke-:',i:2);
gotoxy(11,5+i);write('nim :');readln(nim[i]);
gotoxy(11,6+i);write('nama :');readln(nama[i]);
gotoxy(11,7+i);write('nilai 1 :');readln(nil1[i]);
gotoxy(11,8+i);write('nilai 2 :');readln(nil2[i]);
gotoxy(11,9+i);write('nilai 3 :');readln(nil3[i]);
gotoxy(11,10+i);write('nilai 4 :');readln(nil4[i]);
gotoxy(11,11+i);write('nilai 5 :');readln(nil5[i]);
end;
{ proses data dalam array }
clrscr;
gotoxy(5,4);write(garis);
gotoxy(5,5);write('no');
gotoxy(9,5);write('nim');
gotoxy(18,5);write('nama');
gotoxy(28,5);write('nilai1');
gotoxy(37,5);write('nnil2');
gotoxy(45,5);write('nil3');
gotoxy(53,5);write('nil4');
gotoxy(61,5);write('nil5');
gotoxy(69,5);write('rata');
gotoxy(75,5);write('abjad');
gotoxy(5,6);write(garis);
{ proses cetak isi array dan seleksi kondisi }
bar :=7;
for i:=1 to n do
begin
jum:=(nil1[i]+nil2[i]+nil3[i]+nil4[i]+nil5[i])/5;
if
jum=100 then tl:='A'
ELSE
IF JUM>80 THEN TL:='B'
ELSE
IF JUM>60 THEN TL:='C'
ELSE
IF JUM>50 THEN TL:='D'
else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyelesaian kondisi }
gotoxy(5,bar);writeln(i:2);
gotoxy(9,bar);writeln(nim[i]);
gotoxy(18,bar);writeln(nama[i]);
gotoxy(28,bar);writeln(nil1[i]:4);
gotoxy(37,bar);writeln(nil2[i]:4);
gotoxy(45,bar);writeln(nil3[i]:4);
gotoxy(53,bar);writeln(nil4[i]:4);
gotoxy(61,bar);writeln(nil5[i]:4);
gotoxy(69,bar);writeln(jum:5:1);
gotoxy(77,bar);writeln(tl);
bar:=bar+1;
end;
gotoxy(5,bar+1);writeln(garis);
readln;
end.
PROGRAM MANIPULASISTRING
PROGRAM MANIPULASISTRING;
USES WinCRT;
FUNCTION UCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'a') AND (S[I] <= 'z') THEN
DEC(S[I], 32);
UCASE := S;
END;
FUNCTION LCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'A') AND (S[I] <= 'Z') THEN
INC(S[I], 32);
LCASE := S;
END;
FUNCTION PCASE(S:STRING):STRING;
VAR I, J:INTEGER;
BEGIN
IF (S[1] >= 'a') AND
(S[1] <= 'z') THEN
DEC(S[1], 32);
FOR I:= 2 TO LENGTH(S) DO
IF (S[I] >= 'A') AND
(S[I] <= 'Z') THEN
INC(S[I], 32);
FOR I:= 2 TO LENGTH(S)-1 DO
IF (S[1] = ' ') THEN
BEGIN
J := I;
IF (S[J + 1] >= 'a') AND
(S[J + 1] <= 'z') THEN
DEC(S[J + 1], 32);
END;
PCASE :=S;
END;
BEGIN
CLRSCR;
WRITEln(LCASE('Created By vian sastra'));
WRITEln(UCASE('Created By vian sastra'));
WRITEln(PCASE('Created By vian sastra'));
READLN;
end.
USES WinCRT;
FUNCTION UCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'a') AND (S[I] <= 'z') THEN
DEC(S[I], 32);
UCASE := S;
END;
FUNCTION LCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'A') AND (S[I] <= 'Z') THEN
INC(S[I], 32);
LCASE := S;
END;
FUNCTION PCASE(S:STRING):STRING;
VAR I, J:INTEGER;
BEGIN
IF (S[1] >= 'a') AND
(S[1] <= 'z') THEN
DEC(S[1], 32);
FOR I:= 2 TO LENGTH(S) DO
IF (S[I] >= 'A') AND
(S[I] <= 'Z') THEN
INC(S[I], 32);
FOR I:= 2 TO LENGTH(S)-1 DO
IF (S[1] = ' ') THEN
BEGIN
J := I;
IF (S[J + 1] >= 'a') AND
(S[J + 1] <= 'z') THEN
DEC(S[J + 1], 32);
END;
PCASE :=S;
END;
BEGIN
CLRSCR;
WRITEln(LCASE('Created By vian sastra'));
WRITEln(UCASE('Created By vian sastra'));
WRITEln(PCASE('Created By vian sastra'));
READLN;
end.
Program Penggunaan Case
program penggunaan_case;
uses wincrt;
var
nilai:char;
grade:string;
begin
writeln('nilai yang anda input');
read(nilai);
case nilai of
'a','A':grade:='nilai yang anda dapat 100';
'b','B':grade:='nilai yang anda dapat 80';
'c','C':grade:='nilai yang anda dapat 70';
'd','D':grade:='nilai yang anda dapat 60';
'e','E':grade:='nilai yang anda dapat 50';
ELSE
grade:='nilai yang anda input';
end;
writeln(grade);
end.
uses wincrt;
var
nilai:char;
grade:string;
begin
writeln('nilai yang anda input');
read(nilai);
case nilai of
'a','A':grade:='nilai yang anda dapat 100';
'b','B':grade:='nilai yang anda dapat 80';
'c','C':grade:='nilai yang anda dapat 70';
'd','D':grade:='nilai yang anda dapat 60';
'e','E':grade:='nilai yang anda dapat 50';
ELSE
grade:='nilai yang anda input';
end;
writeln(grade);
end.
Program Zodiak pada Turbo Pascal
program zodiak;
uses wincrt;
var
t,bl,tl,z,j : integer;
ulang : char;
begin
repeat
clrscr;
write ('Masukan Tanggal Lahir (dalam bentuk Angka) : ');
readln(tl );
write ('Masukan Bulan Lahir (dalam bentuk Angka) : ');
readln(bl);
writeln ('-------------------------------------------');
case bl of
01 : begin t := 31; j := 0 end;
02 : begin t := 29; j := 1 end;
03 : begin t := 31; j := 0 end;
04 : begin t := 30; j := 0 end;
05 : begin t := 31; j := -2 end;
06 : begin t := 30; j := -1 end;
07 : begin t := 31; j := -2 end;
08 : begin t := 31; j := -2 end;
09 : begin t := 30; j := -3 end;
10 : begin t := 31; j := -2 end;
11 : begin t := 30; j := -1 end;
12 : begin t := 31; j := -2 end;
else writeln (' Bulan yang anda Maksud Tidak Tersedia');
end;
begin
if ( tl <= t) = true then
begin
write ('Zodiac Anda Adalah ');
z := ((bl * 31) + ((tl + j) - 21)) div 31 ;
case z of
1 : writeln ('Aquarius');
2 : writeln ('Pisces');
3 : writeln ('Aries');
4 : writeln ('Taurus');
5 : writeln ('Gemini ');
6 : writeln ('Cancer');
7 : writeln ('Leo');
8 : writeln ('Virgo');
9 : writeln ('Libra');
10 : writeln ('Scorpio');
11 : writeln ('Sagitarius');
else writeln ('Capricon');
end;
end
else writeln ('Tanggal Tidak Tersedia');
end;
writeln('------------------------------------------------');
write ('Mau Mencoba lagi ? (y/t) : ');
readln(ulang);
until (ulang = 't' ) or (ulang = 'T')
end.
uses wincrt;
var
t,bl,tl,z,j : integer;
ulang : char;
begin
repeat
clrscr;
write ('Masukan Tanggal Lahir (dalam bentuk Angka) : ');
readln(tl );
write ('Masukan Bulan Lahir (dalam bentuk Angka) : ');
readln(bl);
writeln ('-------------------------------------------');
case bl of
01 : begin t := 31; j := 0 end;
02 : begin t := 29; j := 1 end;
03 : begin t := 31; j := 0 end;
04 : begin t := 30; j := 0 end;
05 : begin t := 31; j := -2 end;
06 : begin t := 30; j := -1 end;
07 : begin t := 31; j := -2 end;
08 : begin t := 31; j := -2 end;
09 : begin t := 30; j := -3 end;
10 : begin t := 31; j := -2 end;
11 : begin t := 30; j := -1 end;
12 : begin t := 31; j := -2 end;
else writeln (' Bulan yang anda Maksud Tidak Tersedia');
end;
begin
if ( tl <= t) = true then
begin
write ('Zodiac Anda Adalah ');
z := ((bl * 31) + ((tl + j) - 21)) div 31 ;
case z of
1 : writeln ('Aquarius');
2 : writeln ('Pisces');
3 : writeln ('Aries');
4 : writeln ('Taurus');
5 : writeln ('Gemini ');
6 : writeln ('Cancer');
7 : writeln ('Leo');
8 : writeln ('Virgo');
9 : writeln ('Libra');
10 : writeln ('Scorpio');
11 : writeln ('Sagitarius');
else writeln ('Capricon');
end;
end
else writeln ('Tanggal Tidak Tersedia');
end;
writeln('------------------------------------------------');
write ('Mau Mencoba lagi ? (y/t) : ');
readln(ulang);
until (ulang = 't' ) or (ulang = 'T')
end.
Langganan:
Postingan (Atom)