Program Queue;
Uses wincrt;
Const N = 100;
Type Queve = record
isi : Array[1..N]of integer;
head:integer;
tail: integer;
end;
Procedure CreateQueve(Var S:Queve);
begin
S.head:=0;
S.tail:=0;
end;
Function IsFull(S:Queve):boolean;
begin
IsFull := (S.head = 1) and (S.tail = N);
end;
Function IsEmpty(S:Queve):boolean;
begin
IsEmpty := (S.head = 0 ) and (S.tail = 0);
end;
Procedure add(X:integer; var S:Queve);
begin
If Not IsFull(S) then
begin
S.tail := S.tail + 1;
S.isi[S.tail] := X;
if S.head=0 then
S.head:=S.head+1;
end;
end;
Procedure remove(var X:integer; var S:Queve);
var i:integer;
begin
IF NOt IsEmpty(S) then
begin
X:=S.isi[S.head];
for i:= 2 to S.tail do
S.isi[i-1]:=S.isi[i];
S.tail :=S.tail - 1;
if S.tail=0 then
S.head:=S.head-1;
end;
end;
{Main Program}
Var S : Queve;
X,i,z,m,Y: integer;
Begin
write('masukan jumlah data ');readln(X);
CreateQueve(S);
for i:= 1 to X do
begin
write('masukan data ke',i,' : ');readln(m);
add(m,S);
end;
writeln;
write('jumlah data yang akan dikeluarkan ');readln(Y);
writeln('data yang dikeluarkan : ');
for i:= 1 to Y do
begin
remove(z,S);
writeln(z);
end;
writeln;
writeln('data yang tersisa : ');
for i:= 1 to S.tail do
writeln(S.isi[i]);
writeln;
writeln('S.tail berada di elemen ke ',S.tail);
writeln('S.head berada di elemen ke ',S.head);
End.
SEARCHING
Program pencarian ;
Uses wincrt;
Label 1;
Var
L:array [1..100] of integer;
Bil,I,n:integer;
ul:char;
procedure
tampil;
begin
write ('masukan banyak data:'); readln
(n);
for i:=1 to n do
begin
write ('data [',I,'] :');readln (L
[i]);
end;
end;
procedure seq_search;
begin
write ('angka yang akan di
cari:');readln (bil);
i := 1;
while (I <n) and (L[i] <>
bil) do
begin
i:=i+1;
end;
if (L[i]=bil)then
writeln ('ditemukan pada elemen larik
ke',i)
else
writeln ('tidak ditemukan');
end;
begin
1 :
Clrscr;
Writeln
('----------------------------------------------------------');
Writeln ('------PROGRAM PENCARIAN
ANGKA---------');
Writeln ('----------------------------------------------------------');
Tampil;
Seq_search;
Writeln ;
Write ('apakah anda ingin mengulangi
[Y/T] ? : ');readln (ul);
If (ul ='Y') or (ul ='y') then
Goto 1 ;
Readkey;
End.
SORTING
program counting_sort;
uses wincrt;
type
nilai = array[1..50] of integer;
var
nl : nilai;
mindata,maxdata: integer;
jumlah ,i:integer;
procedure isinilai(var nl:nilai; var
n:integer);
var
j:integer;
begin
write('banyak data : ');
readln(n);
for j:=1 to n do
begin
write('data ke ',j,' : ');
readln(nl[j]);
end;
end;
procedure
minmax(nl:nilai;n:integer;var mindata:integer;var maxdata:integer);
begin
mindata :=nl[1];
maxdata :=nl[1];
for i:=2 to n do
begin
if nl[i] < mindata then mindata
:=nl[i];
if nl[i] > maxdata then maxdata
:=nl[i];
end;
end;
procedure countsort(var
tabint:nilai;n:integer;mindata:integer;maxdata:integer);
const min=1;max=100;
var
i,j,k:integer;
tabcount:array [min..max] of integer;
begin
for i:=mindata to maxdata do
tabcount[i]:=0;
for i:=1 to n do
tabcount[tabint[i]]:=tabcount[tabint[i]]+1;
k:=0;
for i :=mindata to maxdata do
if tabcount[i]<>0 then
for j:=1 to tabcount[i] do
begin
k:=k+1;
tabint[k]:=i;
end;
end;
procedure cetak(nl:nilai;n:integer);
begin
for i:=1 to n do
write(nl[i],' ');
writeln;
end;
begin
isinilai(nl,jumlah);
minmax(nl,jumlah,mindata,maxdata);
writeln('ini data sebelum diurutkan:
');
cetak(nl,jumlah);
countsort(nl,jumlah,mindata,maxdata);
writeln('ini data setelah diurutkan:
');
cetak(nl,jumlah);
readln;
end.
RECORD
uses wincrt;
type
RecBarang=Record
Nama:string[15];
Kualitas:Char;
Harga:String;
end;
var
Barang:RecBarang;
begin
clrscr;
barang.nama:='TV';
barang.kualitas:='A';
barang.Harga:='6000000';
writeln('Nama barang :',Barang.nama);
writeln('Kualitas barang :',Barang.kualitas);
writeln('Harga barang :',Barang.Harga);
end.
STACK
Uses wincrt;
const
max = 10;
var
top,i : byte;
pil,tem,E : char;
stack : array [1..max] of char;
procedure pushanim;
begin
for i :=1 to 18 do
begin
gotoxy(23+i,7); write(tem);
{Delay(30);}
gotoxy(23,7); clreol;
end;
for i:=1 to 14-top do
begin
{delay(30);}
gotoxy(41,6+i); write(' ');
gotoxy(41,7+i); write(tem);
end;
end;
procedure popanim(tem:char);
begin
for i:=1 to 14-top do
begin
{delay(30);}
gotoxy(41,22-i-top);
write(' ');
gotoxy(41,21-i-top);
write(tem);
end;
for i:=1 to 19 do
begin
gotoxy(40+i,7); write(tem);
{delay(30);}
gotoxy(16,7); clreol;
end;
end;
procedure push(e:char);
begin
inc(top);
stack[top] :=e;
pushanim;
end;
procedure pop(e:char);
begin
if top<> 0 then
begin
E:=stack[top];popanim(e);
dec(top);
end else
begin
gotoxy(1,7); write('stack telah
kosong');
readkey;
gotoxy(1,7); clreol;
end;
end;
begin
clrscr;
writeln('ANIMASI STACK');
writeln('1. PUSH');
writeln('2. POP');
writeln('3. QUIT');
writeln('Pilihan anda[1/2/3] = ');
gotoxy(49,6);write('\');
gotoxy(49,8);write('/');
gotoxy(37,10);write('\ /');
for i:=1 to 11 do
begin
gotoxy(38,10+i);
if i=11 then write('|_____|')else
write
('| |');
end;
top := 0;
repeat
gotoxy(23,5);clreol;
pil := readkey;write(pil);
if pil ='1' then
begin
if top<> max then
begin
gotoxy(1,7);write('Masukkan satu Huruf = ');
tem :=
readkey;write(tem);
push(tem);
gotoxy(1,7);clreol;
end else
begin
gotoxy(1,7);write('Stack sudah penuh');readkey;
gotoxy(1,7);clreol;
end;
end else
if pil='2' then pop(tem);
until pil='3';
end.
Program pop_pushModifikasi;
uses wincrt;
const elemen =255; {batas maximum
karakter}
type S255 = string [elemen];
tumpukan = record
isi : s255;
atas : 0..elemen;
end;
var
T : tumpukan;
W, tambah : char;
kalimat : s255;
i,j : integer;
procedure awalan (var T : tumpukan);
begin
T.Atas := 0;
end;
procedure push (var T : tumpukan; X :
char);
begin
T. Atas := T.Atas+1;
T.Isi[T.Atas] := X;
end;
function pop (var T : tumpukan):
char;
begin
pop := T.Isi[T.Atas];
T.atas := T.atas-1;
end;
begin {program utama}
clrscr;
writeln('Masukkan Kalimat : ');
read(kalimat);
writeln;
for i := 1 to length (kalimat) do
push (T, kalimat [i]);
writeln('Elemen yang di-push : ', kalimat);
readln;
writeln('Tambah karakter : ');
readln(tambah);
{melakukan proses pop}
for i := 1 to length (kalimat) do
push (t, kalimat [i]);
writeln;
writeln('Hasil akhir : ');
write(tambah);
{menampilkan hasil proses pop}
for j := 1 to length (kalimat) do
begin
w := pop (T);
write(w);
end;
readln;
end.
LINKED LINK
Uses wincrt;
Var
Kode_Barang:String;
Jumlah_Barang:Integer;
Total_Bayar:Real;
Total_Biaya : real ;
begin
clrscr;
gotoxy(30,2);
Writeln('CV Rahayu Computer');
gotoxy(25,3);
Writeln('JL.Boncis Pulisen
Boyolali');
gotoxy(1,4);
Writeln('********************************************************************************');
gotoxy(20,7);
Writeln('Kode Barang :');
gotoxy(20,8);
Writeln('Jumlah Barang :');
gotoxy(20,10);
Writeln('--------------------------------');
gotoxy(20,11);
Writeln('| Nama Barang |
Harga Satuan |');
gotoxy(20,12);
Writeln('--------------------------------');
gotoxy(20,13);
Writeln('| | |');
gotoxy(20,14);
Writeln('--------------------------------');
gotoxy(20,16);
Writeln('Total Biaya :');
gotoxy(45,20);
Writeln('Terima Kasih Atas Kunjungan
Anda');
gotoxy(45,21);
Writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
gotoxy(48,22);
Writeln('Design By.Rahayu Lestari');
gotoxy(36,7);
Readln(Kode_Barang);
gotoxy(36,8);
Readln(Jumlah_Barang);
gotoxy(23,13);
If Kode_Barang='HD' then
begin
Writeln('Harddisk');
gotoxy(40,13);
Writeln('850000');
gotoxy(37,16);
Total_Biaya:= Jumlah_Barang * 850000;
Writeln('',Total_Biaya:2:0);
readln;
end;
gotoxy(23,13);
If Kode_Barang='MNTR' then
begin
Writeln('Monitor');
gotoxy(40,13);
Writeln('550000');
gotoxy(37,16);
Total_Biaya:= Jumlah_Barang * 550000;
Writeln('',Total_Biaya:2:0);
readln;
end;
gotoxy(23,13);
If Kode_Barang='PRNT' then
begin
Writeln('Printer');
gotoxy(40,13);
Writeln('500000');
gotoxy(37,16);
Total_Biaya:= Jumlah_Barang * 500000;
Writeln('',Total_Biaya:2:0);
readln;
end;
readln;
end.
