Gunawan Corp.
Listingnya:
Program Sorting;
uses crt;
type tarray = array [1..20] of integer;
tsort = object
dataKe, data : tarray;
jum, lokasi, jarak, x, y : integer;
isi : array [1..7] of string;
tekan : char;
pil, pilihan : byte;
procedure input;
procedure tukar(var satu,dua : integer);
procedure ambil_data;
procedure bubble;
procedure bubbleDescending;
procedure selection;
procedure exchange;
procedure insertion;
procedure tampil;
procedure menu;
procedure menu_pilih;
end;
procedure tsort.input;
var
i : integer;
begin
write('masukkan banyaknya jumlah data = ');
readln(jum);
for i := 1 to jum do
begin
write('data ke-',i,':');
readln(dataKe[i]);
end;
end;
procedure tsort.ambil_data;
var
i : integer;
begin
for i := 1 to jum do
begin
data[i] := dataKe[i];
end;
end;
procedure tsort.tukar(var satu,dua : integer);
var
temp : integer;
begin
temp := satu;
satu := dua;
dua := temp;
end;
procedure tsort.bubble;
var
i,j : integer;
begin
ambil_data;
textcolor(white);
writeln('metode bubble sort');
writeln;
write('awal : ');
tampil;
for i := 1 to jum-1 do
begin
write('i = ',i);
for j := 1 to jum-1 do
begin
if data[j] > data[j+1] then
tukar(data[j],data[j+1]);
tampil;
delay(100);
end;
writeln;
end;
write('hasil : ');
tampil;
end;
procedure tsort.bubbleDescending;
var
i,j : integer;
begin
ambil_data;
textcolor(white);
writeln('metode bubble sort Descending');
writeln;
write('awal : ');
tampil;
for i := 1 to jum-1 do
begin
write('i = ',i);
for j := 1 to jum-1 do
begin
if data[j] < data[j+1] then
tukar(data[j],data[j+1]);
tampil;
delay(100);
end;
writeln;
end;
write('hasil : ');
tampil;
end;
procedure tsort.selection;
var
i, j : integer;
begin
ambil_data;
writeln('metode selection');
writeln;
write('awal = ');
tampil;
writeln;
for i := 1 to jum-1 do
begin
lokasi := i;
for j := i+1 to jum do
begin
if data[j] < data [lokasi] then
lokasi := j;
end;
write('i = ',i);
if lokasi <> i then tukar (data[i],data[lokasi]);
tampil;
delay(100);
end;
writeln;
write('hasil = ');
tampil;
end;
procedure tsort.exchange;
var
i, j : integer;
begin
ambil_data;
writeln('metode exchange sort');
writeln;
write('awal = ');
tampil;
writeln;
for i := 1 to jum-1 do
begin
write('i = ',i);
for j := i+1 to jum+1 do
begin
if data[i] < data[j] then
tukar(data[i], data[j]);
tampil;
delay(100);
end;
writeln;
end;
write('hasil : ');
tampil;
end;
procedure tsort.insertion;
var
i, j, temp : integer;
begin
ambil_data;
textcolor(white);
writeln('metode insertion sort');
writeln;
write('awal : ');
tampil;
for i := 1 to jum do
begin
write('i = ',i);
temp := data[i];
j := i - 1;
while (data[j] > temp) and (j>=0) do
begin
data[j+1] := data[j];
j := j-1;
end;
data[j+1] := temp;
tampil;
delay(100);
end;
writeln;
write('hasil : ');
tampil;
end;
procedure tsort.tampil;
var
i : integer;
begin
for i := 1 to jum do
begin
gotoxy(i*6, whereY);
write(data[i] : 4);
end;
writeln;
end;
procedure tsort.menu;
var
i : integer;
begin
x:=30; y:=7;
isi[1] := ' input ';
isi[2] := ' bubble sort ascending';
isi[3] := ' bubble sort descending';
isi[4] := ' selection';
isi[5] := ' exchange';
isi[6] := ' insertion';
isi[7] := ' exit';
for i := 1 to 7 do
begin
gotoxy(x,y+2);
write(isi[i]);
end;
end;
procedure tsort.menu_pilih;
var
i : integer;
pilama : byte;
begin
for i := 1 to 7 do
begin
gotoxy(x,y+i);
write(isi[i]);
end;
pil := 1;
textcolor(white);
repeat
gotoxy(x,y+pil);
textbackground(blue);
write(isi[pil]);
pilama := pil;
tekan := readkey;
case ord(tekan) of
72 : pil := pil - 1;
80 : pil := pil + 1;
end;
gotoxy(x,y+pilama);
textbackground(black);
write(isi[pilama]);
if (pil > 7) then pil := 1;
if (pil < 1) then pil := 7;
textbackground(black);
until tekan = #13;
pilihan := pilama;
end;
var
sort : tsort;
keluar : boolean;
begin
clrscr;
keluar := false;
textbackground(black);
sort.menu;
textbackground(black);
sort.menu_pilih;
repeat
textbackground(black);
case sort.pilihan of
1 : begin
clrscr;
sort.input;
clrscr;
sort.menu_pilih;
end;
2 : begin
clrscr;
sort.bubble;
readln;
clrscr;
sort.menu_pilih;
end;
3 : begin
clrscr;
sort.bubbleDescending;
readln;
clrscr;
sort.menu_pilih;
end;
4 : begin
clrscr;
sort.selection;
readln;
clrscr;
sort.menu_pilih;
end;
5 : begin
clrscr;
sort.exchange;
readln;
clrscr;
sort.menu_pilih;
end;
6 : begin
clrscr;
sort.insertion;
readln;
clrscr;
sort.menu_pilih;
end;
7 : keluar := true;
end;
until keluar;
textbackground(black);
end.
by Jojo SkyLine
Tidak ada komentar:
Posting Komentar