SALAH
uses crt;
var i:integer;
a:integer;
procedure satu;
Procedure dua;
begin
writeln('Prosedure ulang 1-10 dan 10-1');
for i := 1 to 10 do
write(i:4);
writeln;
for a := 10 downto 1 do
write(a:4);
end;
Procedure tiga;
begin
writeln('Procedure tiga ada di dalam procedure satu');
end;
begin
writeln('Procedure Ulang 1-10 dan 10-1');
for i := 1 to 10 do
write (i:4);
writeln;
for a := 10 downto 1 do
write (a:4);
dua;
tiga;
end;
{ modul Utama }
begin
clrscr;
writeln('PROCEDURE UTAMA');
writeln;
satu;
writeln;
readln;
end.
KONVERSI PANJANG KE METER
uses crt;
var
u:string;
j:integer;
h:real;
begin
clrscr;
writeln('KONVERSI PANJANG KE METER');
writeln;
write ('Pilih Unit (mm/cm) : '); readln(u);
write ('Masukkan Jumlah ',u,' : '); readln(j);
if u='mm' then
h:= j/1000;
begin
if u='cm' then
h:= j/100;
end;
writeln;
writeln('hasil ',j,' ',u,' = ',h:8:2,' m');
readln;
end.
STACK
Program Infix_Ke_Postfix;
Uses Crt;
Const MaxElemen = 255;
Type
S255 = String [MaxElemen];
Tumpukan = Record
Isi : S255;
Atas : Integer;
End;
Var
Infix : S255; (* Notasi Infix *)
Lagi : Char;
(* Fungsi untuk menentukan Valensi operator *)
Function Valensi (Tanda_Op : char): integer;
Begin
Case Tanda_Op Of
'^' : Valensi := 3;
'*', '/' : Valensi := 2;
'+', '-' : Valensi := 1;
'(' : Valensi := 0;
End;
End;
Procedure PUSH (Var T : Tumpukan; Elemen : char);
Begin
If T.Atas = MaxElemen then
Writeln('Tumpukan Sudah Penuh')
Else
Begin
T.Atas := T.Atas + 1;
T.Isi [T.Atas] := Elemen;
End;
End;
Function POP (Var T : Tumpukan ) : Char;
Begin
If T.Atas = 0 Then
Begin
Writeln('Tumpukan Sudah Kosong....');
{POP:= 0}
end
Else
Begin
POP := T.Isi[T.Atas];
T.Atas := T.Atas - 1;
End;
End;
Procedure Konversi_Cetak (Infix : S255);
Var
I : Integer;
Operator : Set Of Char;
Temp, Kar : Char;
T : Tumpukan;
Test : Boolean;
Begin
(* Himpunan operator yang diijinkan *)
Operator := ['^']+['*']+['/']+['+']+['-'];
For I := 1 to Length (Infix) Do (* Melakukan Konversi *)
Begin
Kar := Infix[I]; (* Ambil karakter demi karakter *)
If Kar = '('Then (* jika ketemu kurung buka *)
PUSH(T, Kar)
Else
If Kar = ')' Then (* jika ketemu kurung tutup *)
Begin
While T.Isi[T.Atas] <> '(' Do
Write (POP (T) :2);
Temp := POP (T);
End
Else
If Kar in Operator Then (* jika ketemu operator *)
Begin
While (T.Atas <>0) AND (Valensi (Kar) <= Valensi (T.Isi[T.Atas])) Do
Begin
Write(POP(T) :2);
End;
PUSH(T, Kar);
End
Else
If Kar <> ' ' Then (* jika operand lgsg cetak*)
Write (Kar:2);
End; (* Akhir baca Infix *)
If T.Atas <>0 Then (* Jika Stack belum kosong *)
Begin
Repeat
Write (POP(T):2);
Until T.Atas =0;
End;
End; (* Akhir Procedure Konversi *)
(* Program Utama *)
Begin
Clrscr;
Writeln('Mengubah Notasi Infix menjadi Postfix');
Writeln('Dengan Memanfaatkan Struktur Tumpukan');
Writeln('_____________________________________');
Writeln;
Repeat
Write('Masukkan Notasi Infix :');Readln(Infix);
Writeln;
write('Notasi Postfix Hasil :');
(* Panggil Procedure Konversi *)
Konversi_Cetak (Infix);
Writeln; Writeln;
Write('Akan mencoba lagi [Y/T] : '); Readln(Lagi);
Until Lagi in ['T','t','N','n'];
End.
TUMPUKAN
uses crt;
const max = 5;
type
data = record
Nim : string;
Nama : string;
Nilai : integer;
end;
var
Tumpuk : Array[1..max] of data;
Jl,I : integer;
Lagi,Pil : Char;
Procedure Isi;
Begin
Repeat
if Jl=Max then
writeln('Tumpukan Penuh')
Else
Begin
Jl:=Jl+1;
with Tumpuk [Jl] do
Begin
Write('Input Nim : '); readln(Nim);
write('Input Nama : '); readln(Nama);
write('Input Nilai : '); readln(Nilai);
end;
end;
write('Lagi Y/T : '); readln(Lagi);
until (upcase (Lagi)<>'Y');
end;
Procedure Tampil;
Begin
writeln('Nim Nama Nilai');
for I:= 1 to Jl Do
Begin
with Tumpuk[I] do
Begin
writeln(Nim, ' ' , Nama, ' ' , Nilai);
End;
End;
End;
Procedure Hapus;
Begin
if Jl=0 Then
Writeln('Tumpukan Dalam Keadaan Kosong')
Else
Dec(Jl);
End;
{Program Utama}
Begin
Clrscr;
Jl:=0;
Repeat
writeln('1. Isi Tumpukan ');
Writeln('2. Tampil ');
Writeln('3. Hapus ');
Writeln('4. Selesai ');
Write('Pilihan 1/2/3/4 : ');Readln(Pil);
Case Pil Of
'1' : Isi;
'2' : Tampil;
'3' : Hapus;
End;
Until Pil='4';
end.
16 Juni 2012
Contoh Program Turbo Pascal
Program ilustrasi_antrian;
uses crt;
const
maxelemen = 10;
type
antri = Array[1..Maxelemen] of char;
var
antrian : antri;
depan,belakang,pilih : integer;
elemen : Char;
Procedure Kotak;
var
i:integer;
begin
gotoxy(20,15); for i:= 1 to maxelemen *4+1 do write('-');
gotoxy(20,16); for i:= 1 to maxelemen do write('| ');
writeln(' |');
gotoxy(20,17); for i:= 1 to maxelemen *4+1 do write('-');
gotoxy(20,6); write('<--Keluar');
gotoxy(22+maxelemen*4+1,16);write('<--Masuk');
end;
Procedure letakkan(x: char;R:integer);
begin
gotoxy(18+4 * r,16);write(x);
end;
function kosong(Q : antri) : boolean;
begin
kosong:=((depan=0) and (belakang=0));
end;
Procedure Tambah(var antrian: antri; x: char);
begin
if belakang = maxelemen then belakang :=1
else
inc(belakang);
if not (kosong(antrian)) then
begin
antrian[belakang]:=x;
letakkan(x,belakang);
end
else
begin
gotoxy(40,9);write('antrian sudah penuh');
repeat until keypressed;
gotoxy(40,9);write( ' ': 30);
dec(belakang);
if belakang= 0 then belakang := maxelemen;
end;
end;
function hapus (var antrian: antri): char;
begin
if depan = maxelemen then depan:=1
else
begin
inc(depan);hapus:= antrian[depan];
end;
end;
{Program utama}
begin
clrscr;
kotak;
depan:=0; belakang:=0;
repeat
for pilih := 5 to 9 do
begin
gotoxy(40,pilih); write(' ':39);
end;
gotoxy(1,1);
writeln('========================');
writeln(' menu pilihan ');
writeln('1. tambah elemen baru ');
writeln('2. hapus elemen ');
writeln('3. keluar ');
writeln('========================');
writeln(' masukkan pilihan [1..3]: ');
writeln('==========================');
repeat
gotoxy(22,9);writeln(' ');
gotoxy(22,9);readln(pilih);
until Pilih in[1..3];
case pilih of
1: begin
{tambah elemen}
gotoxy(40,5);writeln('menambah elemen');
gotoxy(40,6);writeln('===============');
gotoxy(40,8);writeln('isi elemen');
readln(elemen);
tambah(antrian,elemen);
end;
2: begin
if not (kosong (antrian)) then
begin
elemen:= hapus(antrian);
letakkan(' ',depan);
end
else
begin
gotoxy(30,9);writeln('antrian kosong..!');
elemen:=readkey;
gotoxy(30,9);writeln(' ':30);
end;
end;
end;
until pilih= 3;
end.
ARRAY 1D
uses crt;
var
a:array[1..5] of integer;
i:integer;
begin
clrscr;
a[1]:=90;
a[2]:=75;
a[3]:=80;
a[4]:=70;
a[5]:=60;
for i:=1 to 5 do
begin
writeln('bilangan ke',1,'=',a[i]);
end;
readln;
End.
ARRAY 2D
uses crt;
var tabel:array[1..3,1..2] of integer;
baris,kolom:integer;
begin
clrscr;
tabel[1,1]:=1;
tabel[1,2]:=10;
tabel[2,1]:=2;
tabel[2,2]:=20;
tabel[3,1]:=3;
tabel[3,2]:=30;
for baris:=1 to 3 do
begin
for kolom:=1 to 2 do
begin
writeln('Elemen 1',baris,',',kolom,'1=',tabel[baris,kolom]);
end;
end;
readln;
end.
program kelompok_usia;
uses crt;
var
umur:integer;
nama,kelompok: string;
begin
clrscr;
write('Masukkan Nama Anda : '); readln(Nama);
write('Masukkan Umur Anda : '); readln(Umur);
case umur of
0..5 : kelompok := 'Balita';
6..16 : kelompok := 'Anak-anak';
17..25 : kelompok := 'Remaja';
26..65 : kelompok := 'Dewasa';
66..100 : kelompok := 'Manula';
else
kelompok:='Super Manula';
end;
writeln;
writeln(Nama,' Kamu Tergolong ', kelompok);
readln;
end.
DERETAN
uses crt;
var
i,aw,ak:integer;
begin
clrscr;
writeln('DERET ANGKA');
writeln;
write('Masukkan Angka Awal : '); readln(aw);
write('Masukkan Angka Akhir : '); readln(ak);
writeln;
writeln('HASIL : ');
for i:=aw to ak do
write(i:4);
readln;
end.
NILAI MAHASISWA
uses crt;
var
nilai:integer;
yud:char;
begin
clrscr;
writeln('Nilai Mahasiswa');
writeln;
write('Masukkan Nilai : '); readln(nilai);
if nilai>=80 then
yud:='A'
else if nilai>=70 then
yud:='B'
else if nilai>=60 then
yud:='C'
else if nilai>=50 then
yud:='D'
else
yud:='E';
writeln('yudisium : ',yud);
writeln('Selamat Nilai Anda Memuaskan');
readln;
end.
GOTOXY
uses crt;
var n,i,norut:integer;
bil:array[1..100] of integer;
ulang:char;
begin
clrscr;
gotoxy(5,1);
writeln('input bilangan');
gotoxy(5,3);
write('tentukan banyak data : ');
gotoxy(30,3); readln(n);
for i:=1 to n do
begin
gotoxy(5,5); write('masukan bilangan ke ',i,' : ');
gotoxy(30,5); readln(bil[i]);
gotoxy(30,5); write(' ');
end;
ulang:='y';
while upcase(ulang)='Y' do
begin
clrscr;
gotoxy(5,1); writeln('INPUT BILANGAN');
gotoxy(5,3); writeln('seluruh bilangan telah d input.');
gotoxy(5,4); writeln('sekarang anda dapat menampilkan bilangan yang anda inginkan.');
gotoxy(5,5); writeln(' ');
gotoxy(5,6); write('masukan No. Urut Bilangan : '); readln(norut);
gotoxy(5,8); writeln('bilangan dengan no. urut ',norut,' adalah ',bil[norut]);
gotoxy(5,11);write('anda ingin menampilkan bilangan yang lain? (Y/T) : ');
readln(ulang);
end;
end.
KALI-KALI
uses crt;
var
i,aw,ak:integer;
begin
clrscr;
writeln('DERET ANGKA');
writeln;
write('Masukkan Angka Awal : '); readln(aw);
write('Masukkan Angka Akhir : '); readln(ak);
writeln;
writeln('HASIL : ');
for i:=aw to ak do
write(i:4);
readln;
end.
KREDIT
uses crt;
type
jenisByr = (lunas,kredit);
databarang = record
kode : string[5];
nama : string[20];
harga : real;
case jenis : Jenisbyr of
lunas : (discount : real);
kredit: (DP : real;
JmlhKredit : byte);
end;
var
Barang : array[1..10] of DataBarang;
i,n : byte;
Tb : char;
begin
clrscr;
writeln('<< Program Pembelian Barang >>');
writeln('******************************');
writeln;
write(' Jumlah Barang = '); readln(n);
{ masukan data }
for i := 1 to n do
begin
with barang[i] do
begin
writeln;
writeln('<< Data Barang ',i,'>>');
write(' Kode barang : '); readln(kode);
write(' Nama barang : '); readln(nama);
write(' Harga barang : '); readln(harga);
write(' Tipe Bayar (lunas<L> / Kredit<K>) : '); readln(Tb);
if upcase (TB) = 'L' then
begin
jenis := Lunas;
write(' Besar Discont : '); readln(discount);
end;
if upcase(TB) = 'K' then
begin
jenis := Kredit;
write(' Jumlah DP : '); readln(DP);
write(' Lama Kredit : '); readln(jmlhkredit);
end;
end;
end;
writeln;
write(' Tekan enter untuk menampilkan data barang....?');
readln;
{ menampilkan data }
clrscr;
writeln('Kode':5,'Nama':20,'Harga':10,'Jenis Byr':10,
'discount':10,'DP':10,'N Kredit':10);
write('*********************************');
writeln('****************************************');
writeln;
for i := 1 to n do
begin
with barang [i] do
begin
write(Kode:5,Nama:20,Harga:10:0);
if Jenis = Lunas then
writeln('lunas':10,Discount:10:0,'0':10,'0':10)
else
writeln('Kredit':10,'0':10,DP:10:0,jmlhkredit:10);
end;
end;
write('*********************************');
writeln('**************************************');
writeln;
readln;
end.
LUAS DAN KELILING PERSEGI PANJANG
uses crt;
var
p,l,ls,kl:real;
begin
clrscr;
writeln('LUAS DAN KELILING PERSEGI PANJANG');
writeln;
write('Masukkan Panjang : '); readln(p);
write('Masukkan Lebar : '); readln(l);
ls:=p*l;
kl:=2*(p+l);
writeln;
writeln('luas : ',ls:8:2);
writeln('keliling : ',kl:8:2);
readln;
end.
NILAI
uses crt;
var
Nilai:integer;
yud,ket:string;
begin
clrscr;
write('Masukkan Nilai : '); readln(Nilai);
case Nilai of
0..49:
begin
yud:='E';
ket:='BURUK';
end;
50..59:
begin
yud:='D';
ket:='KURANG MEMUASKAN';
end;
60..69:
begin
yud:='C';
ket:='CUKUP MEMUASKAN';
end;
70..79:
begin
yud:='B';
ket:='MEMUASKAN';
end;
else
begin
yud:='A';
end;
begin
ket:='SANGAT MEMUASKAN';
end;
writeln;
writeln(Nilai, ' yud ' , yud);
writeln(Nilai, ' ket ' , ket);
readln;
end;
end.
PERPANGKATAN
Uses crt;
Var
Bil,Pangkat,i,y:integer;
Begin
Clrscr;
Writeln('PERPANGKATAN');
Writeln;
Write('Masukkan Bilangan : '); readln(Bil);
Write('Masukkan Perpangkatan : '); readln(Pangkat);
Writeln;
Writeln('HASIL');
y:=Bil;
for i:=1 to Pangkat-1 do
Bil:=Bil*y;
Writeln(Bil);
readln;
end.
PERSEGI EMPAT
Uses crt;
Var
Bil,Pangkat,i,y:integer;
Begin
Clrscr;
Writeln('PERPANGKATAN');
Writeln;
Write('Masukkan Bilangan : '); readln(Bil);
Write('Masukkan Perpangkatan : '); readln(Pangkat);
Writeln;
Writeln('HASIL');
y:=Bil;
for i:=1 to Pangkat-1 do
Bil:=Bil*y;
Writeln(Bil);
readln;
end.
PERULANGAN
uses crt;
var bil,i:integer;
begin
clrscr;
write('input bilangan?'); readln(bil);
writeln;
writeln('hasil :');
for i:= 1 to bil do
if bil mod i =0 then
write(i:4);
readln;
End.
PROCEDURE
uses crt;
procedure satu;
Procedure dua;
begin
writeln('Procedure dua ada di dalam procedure satu');
end;
Procedure tiga;
begin
writeln('Procedure tiga ada di dalam procedure satu');
end;
begin
writeln('ini berada di dalam procedure satu');
writeln;
dua;
tiga;
end;
{ modul Utama }
begin
clrscr;
writeln('Ini berada di dalam modul utama');
writeln;
satu;
readln;
end.
RATA-RATA
uses crt;
var n,i,total:integer;
rata:real;
bil:array[1..100] of integer;
begin
clrscr;
writeln('MENCARI RATA-RATA');
writeln;
write('tentukan banyak data : '); readln(n);
writeln;
total:=0;
for i:=1 to n do
begin
write('masukan bilangan ke ',i,' : '); readln(bil[i]);
total:=total + bil[i];
end;
rata:=total/n;
writeln;
writeln('total :',total);
writeln('rata-rata :',rata:2:2);
readln;
end.
RECORD
uses crt;
Type
DataMhs = Record
NIM : string[9];
NAMA : string[20];
ALAMAT : string[25];
JURUSAN : string[15];
End;
var
jmlhmhs,i : byte;
mahasiswa : array[1..50] of datamhs;
begin
clrscr;
{ memasukan data mahasiswa }
writeln('<*> Program Data Mahasiswa <*>');
writeln('******************************');
writeln;
write('Masukan Banyak Mahasiswa = ');readln(jmlhmhs);
for i := 1 to jmlhmhs do
begin
writeln;
with Mahasiswa[i] do
begin
writeln('<< data mahasiwa ke - ',i,' >>');
write ('Nim : ');readln (NIM);
write ('Nama : ');readln (NAMA);
write ('Alamat : ');readln (ALAMAT);
write ('Jurusan : ');readln (JURUSAN);
end;
End;
clrscr;
writeln(' Proses input data selesai .....');
writeln(' Tekan Enter untuk menampilkan data mahasiswa. ');
readln;
{Menampilkan data Mahasiswa}
clrscr;
writeln('<< Daftar Mahasiswa STT Harapan Medan >>');
writeln('****************************************');
writeln;
writeln('Nim':10,'Nama':20,'Alamat':25,'Jurusan':15);
write('***********************************');
writeln('***********************************');
for i := 1 to jmlhmhs do
begin
with Mahasiswa[i] do
begin
writeln(Nim:10,Nama:20,Alamat:25,Jurusan:15);
end;
end;
write('***********************************');
writeln('***********************************');
readln;
end.
uses crt;
const
maxelemen = 10;
type
antri = Array[1..Maxelemen] of char;
var
antrian : antri;
depan,belakang,pilih : integer;
elemen : Char;
Procedure Kotak;
var
i:integer;
begin
gotoxy(20,15); for i:= 1 to maxelemen *4+1 do write('-');
gotoxy(20,16); for i:= 1 to maxelemen do write('| ');
writeln(' |');
gotoxy(20,17); for i:= 1 to maxelemen *4+1 do write('-');
gotoxy(20,6); write('<--Keluar');
gotoxy(22+maxelemen*4+1,16);write('<--Masuk');
end;
Procedure letakkan(x: char;R:integer);
begin
gotoxy(18+4 * r,16);write(x);
end;
function kosong(Q : antri) : boolean;
begin
kosong:=((depan=0) and (belakang=0));
end;
Procedure Tambah(var antrian: antri; x: char);
begin
if belakang = maxelemen then belakang :=1
else
inc(belakang);
if not (kosong(antrian)) then
begin
antrian[belakang]:=x;
letakkan(x,belakang);
end
else
begin
gotoxy(40,9);write('antrian sudah penuh');
repeat until keypressed;
gotoxy(40,9);write( ' ': 30);
dec(belakang);
if belakang= 0 then belakang := maxelemen;
end;
end;
function hapus (var antrian: antri): char;
begin
if depan = maxelemen then depan:=1
else
begin
inc(depan);hapus:= antrian[depan];
end;
end;
{Program utama}
begin
clrscr;
kotak;
depan:=0; belakang:=0;
repeat
for pilih := 5 to 9 do
begin
gotoxy(40,pilih); write(' ':39);
end;
gotoxy(1,1);
writeln('========================');
writeln(' menu pilihan ');
writeln('1. tambah elemen baru ');
writeln('2. hapus elemen ');
writeln('3. keluar ');
writeln('========================');
writeln(' masukkan pilihan [1..3]: ');
writeln('==========================');
repeat
gotoxy(22,9);writeln(' ');
gotoxy(22,9);readln(pilih);
until Pilih in[1..3];
case pilih of
1: begin
{tambah elemen}
gotoxy(40,5);writeln('menambah elemen');
gotoxy(40,6);writeln('===============');
gotoxy(40,8);writeln('isi elemen');
readln(elemen);
tambah(antrian,elemen);
end;
2: begin
if not (kosong (antrian)) then
begin
elemen:= hapus(antrian);
letakkan(' ',depan);
end
else
begin
gotoxy(30,9);writeln('antrian kosong..!');
elemen:=readkey;
gotoxy(30,9);writeln(' ':30);
end;
end;
end;
until pilih= 3;
end.
ARRAY 1D
uses crt;
var
a:array[1..5] of integer;
i:integer;
begin
clrscr;
a[1]:=90;
a[2]:=75;
a[3]:=80;
a[4]:=70;
a[5]:=60;
for i:=1 to 5 do
begin
writeln('bilangan ke',1,'=',a[i]);
end;
readln;
End.
ARRAY 2D
uses crt;
var tabel:array[1..3,1..2] of integer;
baris,kolom:integer;
begin
clrscr;
tabel[1,1]:=1;
tabel[1,2]:=10;
tabel[2,1]:=2;
tabel[2,2]:=20;
tabel[3,1]:=3;
tabel[3,2]:=30;
for baris:=1 to 3 do
begin
for kolom:=1 to 2 do
begin
writeln('Elemen 1',baris,',',kolom,'1=',tabel[baris,kolom]);
end;
end;
readln;
end.
program kelompok_usia;
uses crt;
var
umur:integer;
nama,kelompok: string;
begin
clrscr;
write('Masukkan Nama Anda : '); readln(Nama);
write('Masukkan Umur Anda : '); readln(Umur);
case umur of
0..5 : kelompok := 'Balita';
6..16 : kelompok := 'Anak-anak';
17..25 : kelompok := 'Remaja';
26..65 : kelompok := 'Dewasa';
66..100 : kelompok := 'Manula';
else
kelompok:='Super Manula';
end;
writeln;
writeln(Nama,' Kamu Tergolong ', kelompok);
readln;
end.
DERETAN
uses crt;
var
i,aw,ak:integer;
begin
clrscr;
writeln('DERET ANGKA');
writeln;
write('Masukkan Angka Awal : '); readln(aw);
write('Masukkan Angka Akhir : '); readln(ak);
writeln;
writeln('HASIL : ');
for i:=aw to ak do
write(i:4);
readln;
end.
NILAI MAHASISWA
uses crt;
var
nilai:integer;
yud:char;
begin
clrscr;
writeln('Nilai Mahasiswa');
writeln;
write('Masukkan Nilai : '); readln(nilai);
if nilai>=80 then
yud:='A'
else if nilai>=70 then
yud:='B'
else if nilai>=60 then
yud:='C'
else if nilai>=50 then
yud:='D'
else
yud:='E';
writeln('yudisium : ',yud);
writeln('Selamat Nilai Anda Memuaskan');
readln;
end.
GOTOXY
uses crt;
var n,i,norut:integer;
bil:array[1..100] of integer;
ulang:char;
begin
clrscr;
gotoxy(5,1);
writeln('input bilangan');
gotoxy(5,3);
write('tentukan banyak data : ');
gotoxy(30,3); readln(n);
for i:=1 to n do
begin
gotoxy(5,5); write('masukan bilangan ke ',i,' : ');
gotoxy(30,5); readln(bil[i]);
gotoxy(30,5); write(' ');
end;
ulang:='y';
while upcase(ulang)='Y' do
begin
clrscr;
gotoxy(5,1); writeln('INPUT BILANGAN');
gotoxy(5,3); writeln('seluruh bilangan telah d input.');
gotoxy(5,4); writeln('sekarang anda dapat menampilkan bilangan yang anda inginkan.');
gotoxy(5,5); writeln(' ');
gotoxy(5,6); write('masukan No. Urut Bilangan : '); readln(norut);
gotoxy(5,8); writeln('bilangan dengan no. urut ',norut,' adalah ',bil[norut]);
gotoxy(5,11);write('anda ingin menampilkan bilangan yang lain? (Y/T) : ');
readln(ulang);
end;
end.
KALI-KALI
uses crt;
var
i,aw,ak:integer;
begin
clrscr;
writeln('DERET ANGKA');
writeln;
write('Masukkan Angka Awal : '); readln(aw);
write('Masukkan Angka Akhir : '); readln(ak);
writeln;
writeln('HASIL : ');
for i:=aw to ak do
write(i:4);
readln;
end.
KREDIT
uses crt;
type
jenisByr = (lunas,kredit);
databarang = record
kode : string[5];
nama : string[20];
harga : real;
case jenis : Jenisbyr of
lunas : (discount : real);
kredit: (DP : real;
JmlhKredit : byte);
end;
var
Barang : array[1..10] of DataBarang;
i,n : byte;
Tb : char;
begin
clrscr;
writeln('<< Program Pembelian Barang >>');
writeln('******************************');
writeln;
write(' Jumlah Barang = '); readln(n);
{ masukan data }
for i := 1 to n do
begin
with barang[i] do
begin
writeln;
writeln('<< Data Barang ',i,'>>');
write(' Kode barang : '); readln(kode);
write(' Nama barang : '); readln(nama);
write(' Harga barang : '); readln(harga);
write(' Tipe Bayar (lunas<L> / Kredit<K>) : '); readln(Tb);
if upcase (TB) = 'L' then
begin
jenis := Lunas;
write(' Besar Discont : '); readln(discount);
end;
if upcase(TB) = 'K' then
begin
jenis := Kredit;
write(' Jumlah DP : '); readln(DP);
write(' Lama Kredit : '); readln(jmlhkredit);
end;
end;
end;
writeln;
write(' Tekan enter untuk menampilkan data barang....?');
readln;
{ menampilkan data }
clrscr;
writeln('Kode':5,'Nama':20,'Harga':10,'Jenis Byr':10,
'discount':10,'DP':10,'N Kredit':10);
write('*********************************');
writeln('****************************************');
writeln;
for i := 1 to n do
begin
with barang [i] do
begin
write(Kode:5,Nama:20,Harga:10:0);
if Jenis = Lunas then
writeln('lunas':10,Discount:10:0,'0':10,'0':10)
else
writeln('Kredit':10,'0':10,DP:10:0,jmlhkredit:10);
end;
end;
write('*********************************');
writeln('**************************************');
writeln;
readln;
end.
LUAS DAN KELILING PERSEGI PANJANG
uses crt;
var
p,l,ls,kl:real;
begin
clrscr;
writeln('LUAS DAN KELILING PERSEGI PANJANG');
writeln;
write('Masukkan Panjang : '); readln(p);
write('Masukkan Lebar : '); readln(l);
ls:=p*l;
kl:=2*(p+l);
writeln;
writeln('luas : ',ls:8:2);
writeln('keliling : ',kl:8:2);
readln;
end.
NILAI
uses crt;
var
Nilai:integer;
yud,ket:string;
begin
clrscr;
write('Masukkan Nilai : '); readln(Nilai);
case Nilai of
0..49:
begin
yud:='E';
ket:='BURUK';
end;
50..59:
begin
yud:='D';
ket:='KURANG MEMUASKAN';
end;
60..69:
begin
yud:='C';
ket:='CUKUP MEMUASKAN';
end;
70..79:
begin
yud:='B';
ket:='MEMUASKAN';
end;
else
begin
yud:='A';
end;
begin
ket:='SANGAT MEMUASKAN';
end;
writeln;
writeln(Nilai, ' yud ' , yud);
writeln(Nilai, ' ket ' , ket);
readln;
end;
end.
PERPANGKATAN
Uses crt;
Var
Bil,Pangkat,i,y:integer;
Begin
Clrscr;
Writeln('PERPANGKATAN');
Writeln;
Write('Masukkan Bilangan : '); readln(Bil);
Write('Masukkan Perpangkatan : '); readln(Pangkat);
Writeln;
Writeln('HASIL');
y:=Bil;
for i:=1 to Pangkat-1 do
Bil:=Bil*y;
Writeln(Bil);
readln;
end.
PERSEGI EMPAT
Uses crt;
Var
Bil,Pangkat,i,y:integer;
Begin
Clrscr;
Writeln('PERPANGKATAN');
Writeln;
Write('Masukkan Bilangan : '); readln(Bil);
Write('Masukkan Perpangkatan : '); readln(Pangkat);
Writeln;
Writeln('HASIL');
y:=Bil;
for i:=1 to Pangkat-1 do
Bil:=Bil*y;
Writeln(Bil);
readln;
end.
PERULANGAN
uses crt;
var bil,i:integer;
begin
clrscr;
write('input bilangan?'); readln(bil);
writeln;
writeln('hasil :');
for i:= 1 to bil do
if bil mod i =0 then
write(i:4);
readln;
End.
PROCEDURE
uses crt;
procedure satu;
Procedure dua;
begin
writeln('Procedure dua ada di dalam procedure satu');
end;
Procedure tiga;
begin
writeln('Procedure tiga ada di dalam procedure satu');
end;
begin
writeln('ini berada di dalam procedure satu');
writeln;
dua;
tiga;
end;
{ modul Utama }
begin
clrscr;
writeln('Ini berada di dalam modul utama');
writeln;
satu;
readln;
end.
RATA-RATA
uses crt;
var n,i,total:integer;
rata:real;
bil:array[1..100] of integer;
begin
clrscr;
writeln('MENCARI RATA-RATA');
writeln;
write('tentukan banyak data : '); readln(n);
writeln;
total:=0;
for i:=1 to n do
begin
write('masukan bilangan ke ',i,' : '); readln(bil[i]);
total:=total + bil[i];
end;
rata:=total/n;
writeln;
writeln('total :',total);
writeln('rata-rata :',rata:2:2);
readln;
end.
RECORD
uses crt;
Type
DataMhs = Record
NIM : string[9];
NAMA : string[20];
ALAMAT : string[25];
JURUSAN : string[15];
End;
var
jmlhmhs,i : byte;
mahasiswa : array[1..50] of datamhs;
begin
clrscr;
{ memasukan data mahasiswa }
writeln('<*> Program Data Mahasiswa <*>');
writeln('******************************');
writeln;
write('Masukan Banyak Mahasiswa = ');readln(jmlhmhs);
for i := 1 to jmlhmhs do
begin
writeln;
with Mahasiswa[i] do
begin
writeln('<< data mahasiwa ke - ',i,' >>');
write ('Nim : ');readln (NIM);
write ('Nama : ');readln (NAMA);
write ('Alamat : ');readln (ALAMAT);
write ('Jurusan : ');readln (JURUSAN);
end;
End;
clrscr;
writeln(' Proses input data selesai .....');
writeln(' Tekan Enter untuk menampilkan data mahasiswa. ');
readln;
{Menampilkan data Mahasiswa}
clrscr;
writeln('<< Daftar Mahasiswa STT Harapan Medan >>');
writeln('****************************************');
writeln;
writeln('Nim':10,'Nama':20,'Alamat':25,'Jurusan':15);
write('***********************************');
writeln('***********************************');
for i := 1 to jmlhmhs do
begin
with Mahasiswa[i] do
begin
writeln(Nim:10,Nama:20,Alamat:25,Jurusan:15);
end;
end;
write('***********************************');
writeln('***********************************');
readln;
end.
Langganan:
Postingan (Atom)