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.
Tidak ada komentar:
Posting Komentar
Berikan komentar yang besifat Positif..