Cac thuat toan sap xep

program Cac_Thuat_Toan_SX;
uses crt,graph;
const nmax=20;
type
mang= array[1..nmax] of integer;
strn= string[nmax];
bangkt= array[1..nmax] of strn;
Obj= object
procedure Menuchinh;
procedure Move(n,x1,y1,x2,y2,h:integer;b:boolean;
nd:bangkt;mnc,mcc,mnr,mcr:integer;var chon:integer);
procedure Bye;
end;
var
gd,gm: integer;
chon,chon_q,d,k,i,j,tg,toi,n,x1,y1,x2,y2: integer;
chon1,ch: char;
a,b,c,Item,tamx,tamy,r: mang;
Ok: Boolean;
Ob_ject: Obj;
Phim: bangkt;
(*======================================================*)
procedure Gioi_thieu;
Procedure Duongchay(ax,ay,bx,by:integer;mau:byte);
begin
setfillstyle(1,mau);
bar(ax,ay,bx,by);
end;
begin
i:=0;j:=640; k:=1600;
Setbkcolor(black);

settextstyle(1,0,4);
setcolor(15);
outtextxy(90,120,'CAI DAT MOT SO THUAT TOAN ');
outtextxy(257,160,'SAP XEP');
settextstyle(0,0,0);
setcolor(12);
outtextxy(140,220,'---------------------o0o----------------------');
setcolor(1);
repeat
j:=j-1;
i:=i+1; k:=k-1 ;
if j=0 then k:=850;


if k=0 then j:=850;
settextstyle(2,0,6);
setcolor(15);
outtextxy(j,420,'Nhan Phim Bat Ky de Tiep Tuc...');
outtextxy(k,420,'Nhan Phim Bat Ky De Tiep Tuc...');
delay(10);
duongchay(0,422,getmaxx,439,1);
until (keypressed) or (i>1500);
if i>5 then exit;
end;
(*==========================================================
==*)
procedure nhap;
begin
textbackground(1);
clrscr;

textcolor(14);
Window(10,5,70,20);
write('Ban hay nhap vao so phan tu cua mang can sap xep (n>0,n<=11), n= ');
repeat
readln(n);
if (n<=0) or (n>11) then
begin
clrscr;
write('Moi ban nhap lai, n= ');
end;
until (n>0) and (n<=11);
for i:=1 to n do
begin
repeat
clrscr;
textbackground(1);
writeln('Mang can sap co ',n,' phan tu:');
writeln('Gia tri cua cac phan tu 3writeln;
for j:=1 to i-1 do writeln('a[',j,']= ',a[j]);
Write('Nhap a[',i,']= ');
readln(a[i]);
if (a[i]<=3) or (a[i]>30) then
begin
sound(1047);delay(150); nosound;
textcolor(15);write('Nhap lai!'); delay(200);
textcolor(14);
end;

until (a[i]>3) and (a[i]<=30);
end;
clrscr;
writeln('Mang can sap co ',n,' phan tu:'); writeln;
for j:=1 to i do writeln('a[',j,']= ',a[j]);
writeln;
textcolor(15); write('An Enter de tiep tuc !');
readln;
end;
(*==========================================================
===*)
procedure tron(x,y,bk:integer);
var xau:string;
begin
setfillstyle(1,12);
setcolor(12);
circle(x,y,bk);
floodfill(x,y,12);
str(bk,xau);
setcolor(15);
outtextxy(x-4,y-3,xau);
end;
(*==========================================================
===*)
procedure xoa(x,y,bk: integer);
begin
setfillstyle(1,1);
setcolor(1);
circle(x,y,bk);
floodfill(x,y,1);

end;
(****************************************************************)
procedure selection;
begin
for i:=1 to n do r[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep SELECTION SORT');
settextstyle(0,0,0);
setcolor(14);


outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin
tamy[i]:=350;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
for i:=1 to n-1 do
begin
k:=i;
for j:=i+1 to n do
if r[j] < r[k] then k:=j;

if k<>i then
begin
ch:=readkey;
if ch=#27 then exit
else
begin
tg:=r[i];
tron(tamx[i],tamy[i]-120,tg);
xoa(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[i]:=r[k];
tron(tamx[i],tamy[i],r[i]);
xoa(tamx[k],tamy[k],r[k]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[k]:=tg;
tron(tamx[k],tamy[k],r[k] );
xoa(tamx[i],tamy[i]-120,tg);
end;
end;
end;
end;

setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
end;
(*==========================================================
=*)
procedure insertion;
begin
for i:=1 to n do r[i]:=a[i];
setbkcolor(blue);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep INSERTION SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin
tamy[i]:=340;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else

begin
for i:=2 to n do
begin
tg:=r[i];
tron(tamx[i],tamy[i]-120,tg);
xoa(tamx[i],tamy[i],30);
ch:=readkey;
if ch=#27 then exit
else j:=i-1;
while tgbegin
xoa(tamx[j+1],tamy[j+1],32);
r[j+1]:=r[j];
tron(tamx[j+1],tamy[j+1],r[j+1]);


xoa(tamx[j],tamy[j],30);
ch:= readkey;
if ch=#27 then exit
else j:=j-1;
end;
r[j+1]:=tg;
tron(tamx[j+1],tamy[j+1],r[j+1]);
xoa(tamx[i],tamy[i]-120,30);
ch:=readkey;
if ch=#27 then exit
end;
end;
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');

setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
setcolor(1);
textcolor(1);
readln;
end;
(*==========================================================
=========*)
procedure bubble;
begin
for i:=1 to n do r[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(60,150,'Day la kieu sap xep BUBBLE SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(100,300,'An phim bat ky de tiep tuc,');
outtextxy(100,320,'An Esc de thoat !');
for i:= 1 to n do
begin
tamx[i]:=450;
tamy[i]:=25+(i-1)*60;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin

for i:=n downto 1 do
for j:=2 to i do
if r[j] < r[j-1] then
begin
tg:=r[j-1];
ch:=readkey;
if ch=#27 then exit
else
begin
tron(tamx[j-1]+120,tamy[j-1],tg);
xoa(tamx[j-1],tamy[j-1],30);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[j-1]:=r[j];
tron(tamx[j-1],tamy[j-1],r[j-1] );
xoa(tamx[j],tamy[j],30);
end;
r[j]:=tg;
ch:=readkey;
if ch=#27 then exit
else
begin
tron(tamx[j],tamy[j],r[j]);
xoa(tamx[j-1]+120,tamy[j-1],30);
end;

end;
end;
setcolor(1);
outtextxy(100,300,'An phim bat ky de tiep tuc,');
outtextxy(100,320,'An Esc de thoat !');
setcolor(15);
outtextxy(80,280,'Mang da duoc sap xep.');
outtextxy(80,300,'An Enter de ve menu chinh !');
textcolor(1);
readln;
end;
(*==========================================================
==*)
Procedure ShellSort;
label 0;
Var i,j,q,m:integer;


begin
for i:=1 to n do b[i]:=a[i];
cleardevice;
setbkcolor(1);
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep SHELL SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin

tamy[i]:=340;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],b[i]);
end;
ch:=readkey;
if ch=#27 then exit ;
q:=1;
repeat q:=3*q+1;until q>n;
repeat
q:=q div 3;
for i:= q+1 to n do
begin
xoa(100,200,30);
m:=b[i];
tron(100,200,m);
xoa(tamx[i],tamy[i],30);
ch:=readkey;
if ch=#27 then exit;
j:=i;
while b[j-q]>m do
begin
b[j]:=b[j-q];
xoa(tamx[j],tamy[j],30);
xoa(tamx[j-q],tamy[j-q],30);
tron(tamx[j],tamy[j],b[j]);
ch:=readkey;
if ch=#27 then exit ;
j:=j-q;
if jend;

0: begin
b[j]:=m;
xoa(tamx[j],tamy[j],30);


tron(tamx[j],tamy[j],b[j]);
end;
end;
xoa(100,200,30);
for i:=1 to n do xoa(tamx[i],tamy[i],30);
for i:=1 to n do tron(tamx[i],tamy[i],b[i]);
ch:=readkey;
if ch=#27 then exit
until q=1;
for i:=1 to n do write(b[i]:3);
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
end;
(*==========================================================
======*)
Procedure Quick;
procedure tronq(x,y,bk:integer;mau:byte);
var xau:string;
begin
setfillstyle(1,mau);
setcolor(mau);

circle(x,y,bk);
floodfill(x,y,mau);
str(bk,xau);
setcolor(15);
outtextxy(x-4,y-3,xau);
end;
Procedure qs1(l,r:integer);
var v,t,i,j:integer;
begin
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep QUICK SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:=1 to n do


begin
tamy[i]:=350;
tamx[i]:=38+(i-1)*62;
end;
for i:=1 to n do tron(tamx[i],tamy[i],b[i]);
if r>l then
begin
ch:=readkey;
if ch=#27 then exit else
begin

v:=b[r];
tronq(tamx[r],tamy[r],v,10);
setcolor(11);
outtextxy(tamx[r]-10,tamy[r]+40,'Key');
setcolor(15);
end;
i:=l-1; j:=r;
ch:=readkey;
if ch=#27 then exit else
begin
repeat
repeat i:=i+1; until b[i]>=v;
repeat j:=j-1; until b[j]<=v;
tronq(tamx[i],tamy[i],b[i],cyan);
tronq(tamx[j],tamy[j],b[j],cyan);
ch:=readkey;
if ch=#27 then exit else
begin
t:=b[i];
tron(400,200,t);
xoa(tamx[i],tamy[i],30);
end;
ch:=readkey;
if ch=#27 then exit else
begin
b[i]:=b[j];
tron(tamx[i],tamy[i],b[j] );
xoa(tamx[j],tamy[j],30);
end;
ch:=readkey;

if ch=#27 then exit else
begin
b[j]:=t;
tron(tamx[j],tamy[j],b[j]);
xoa(400,200,30);


end;
until jend;
ch:=readkey;
b[j]:=b[i]; b[i]:=b[r]; b[r]:=t;
qs1(l,i-1);
qs1(i+1,r);
end;
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
end;
Begin
for k:=1 to n do b[k]:=a[k];
qs1(1,n);
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
End;
(*==========================================================
====*)
(* program heap_sort;
USES CRT,GRAPH;

CONST R1=16;R2=16;
TYPE POINT=RECORD
X,Y:INTEGER;
GT:INTEGER;
END;
MT=ARRAY[1..100] OF POINT;
VAR K1,K2,GM,GD,I,J,N,H,K,L:INTEGER;
maxx,maxy: integer;
ch:char;
BO,TG:INTEGER;
G,X1,X2,Y1,Y2:INTEGER;
A:MT;
s:string[10];
TAM:POINT;
PROCEDURE VENUT1(X,Y:INTEGER;VAR TAM :POINT);
BEGIN
SETCOLOR(BLUE);
SETFILLSTYLE(1,YELLOW);
STR(TAM.GT,S);
FILLELLIPSE(X,Y,R2,R1);
SETCOLOR(1);


SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,0);
OUTTEXTXY(X-R2+9,Y,S);
END;
PROCEDURE VENUT2(X,Y:INTEGER;VAR TAM :POINT);
BEGIN
SETCOLOR(YELLOW);
SETFILLSTYLE(1,BLUE);

STR(TAM.GT,S);
FILLELLIPSE(X,Y,R2,R1);
SETCOLOR(YELLOW);
{Justify(centertext,centertext);}
OUTTEXTXY(X-R2+9,Y,S);
END;
PROCEDURE VEKHUNG1(VAR A:MT);
VAR DEM,TANG,COT,DONG:INTEGER;
BEGIN
DONG:=R1+5;COT:=GETMAXX DIV 2;
A[1].X:=COT;A[1].Y:=DONG;
TANG:=ROUND(LN(N+1)/LN(2));
H:=(GETMAXY) DIV TANG -R1; I:=1;
VENUT1(A[I].X,A[I].Y,A[I]);
IF (2*I<=N) THEN
LINE(A[I].X,A[I].Y+R1,A[I].X-(COT DIV 2),(A[I].Y+H-R1));
IF((2*I+1)<=N) THEN
LINE(A[I].X,A[I].Y+R1,A[I].X+(COT DIV 2),(A[I].Y+H-R1));
DEM:=1;K:=2;
REPEAT
DONG:=DONG+H;COT:=COT DIV 2;L:=1;J:=0;K:=K*2;
WHILE (DEMBEGIN
INC(I);
A[I].X:=COT*L;A[I].Y:=DONG;
L:=L+2;DEM:=DEM+1; INC(J);
VENUT1(A[I].X,A[I].Y,A[I]);
IF (2*I<=N) THEN
LINE(A[I].X,A[I].Y+R1,A[I].X-(COT DIV 2),(A[I].Y+H-R1));
IF ((2*I+1)<=N) THEN

LINE(A[I].X,A[I].Y+R1,A[I].X+(COT DIV 2),(A[I].Y+H-R1));
END;
UNTIL (DEM=N)OR(COTEND;
PROCEDURE LABAY1(X1,Y1,X2,Y2:INTEGER);
VAR D:INTEGER;P,Q:POINTER;
BEGIN
D:=1;


H:=IMAGESIZE(X1-R2,Y1-R1,X1+R2,Y1+R1);
L:=IMAGESIZE(X2-R2,Y2-R1,X2+R2,Y2+R1);
GETMEM(P,H);
GETMEM(Q,L);
GETIMAGE(X1-R2,Y1-R1,X1+R2,Y1+R1,P^);
GETIMAGE(X2-R2,Y2-R1,X2+R2,Y2+R1,Q^);
IF (X1 BEGIN
K1:=X2-X1;K2:=Y2-Y1;
REPEAT
G:=RANDOM(30);SOUND(G*200);
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
X2:=X2-D;X1:=X1+D;K1:=K1-D;
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
DELAY(2);
NOSOUND;
UNTIL K1=0;
REPEAT

G:=RANDOM(20);SOUND(G*300);
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
Y1:=Y1+D;Y2:=Y2-D;K2:=K2-D;
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
DELAY(2);
NOSOUND;
UNTIL K2=0;
END
ELSE
BEGIN
K1:=X1-X2;K2:=Y2-Y1;
REPEAT
G:=RANDOM(10);SOUND(G*400);
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
X2:=X2+D;X1:=X1-D;K1:=K1-D;
PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
DELAY(2);
NOSOUND;
UNTIL K1=0;
REPEAT
G:=RANDOM(10);SOUND(G*400);


PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
Y1:=Y1+D;Y2:=Y2-D;K2:=K2-D;

PUTIMAGE(X2-R2,Y2-R1,Q^,XORPUT);
PUTIMAGE(X1-R2,Y1-R1,P^,XORPUT);
DELAY(2);
NOSOUND;
UNTIL K2=0;
END ;
FREEMEM(P,H);FREEMEM(Q,H); NOSOUND;
END;
PROCEDURE CHUYEN(VAR A:MT;L,R:INTEGER);
BEGIN
I:=L;J:=2*I;BO:=A[I].GT;
WHILE (JBEGIN
IF (A[J].GTIF (BOBEGIN
LABAY1(A[I].X,A[I].Y,A[J].X,A[J].Y);
A[I].GT:=A[J].GT;A[J].GT:=BO;
I:=J;J:=2*I;
END
ELSE J:=J+R;
END;
IF (J=R )THEN
BEGIN
IF (BOBEGIN
LABAY1(A[I].X,A[I].Y,A[J].X,A[J].Y);
A[I].GT:=A[J].GT;A[J].GT:=BO;
END;
END;

END;
PROCEDURE CREAT_HEAP(VAR X:MT;VAR N:INTEGER);
BEGIN
K:=N DIV 2+1;
WHILE K>1 DO
BEGIN
K:=K-1;
CHUYEN(X,K,N);
END;
END;
PROCEDURE HEAPSORT(VAR X:MT;VAR N:INTEGER);
BEGIN


VEKHUNG1(A); I:=1; L:=300;
SETCOLOR(15);
CREAT_HEAP(A,N);
FOR k:= N DOWNTO 2 DO
BEGIN
INC(I);L:=L+20;
LABAY1(X[1].X,X[1].Y,X[K].X,X[K].Y);
TG:=X[1].GT;X[1].GT:=X[K].GT;X[K].GT:=TG;
VENUT2(A[K].X,A[K].Y,A[K]);
CHUYEN(X,1,K-1);
END;
VENUT2(A[1].X,A[1].Y,A[1]);
END;
BEGIN {CHUONG TRINH CHINH }
repeat
CLRSCR;

TEXTBACKGROUND(green);
GOTOXY(50,100);
TEXTCOLOR(WHITE+BLINK);
WRITE(' nhap may phan tu cho Heapsort (n<=18): ');
READLN(N);
TEXTCOLOR(LIGHTGREEN);
FOR I:=1 TO N DO
BEGIN
WRITE('A[',i,']= ' );
READLN(A[I].GT); A[I].X:=0;A[I].Y:=0;
END;
CLRSCR;
GD:=DETECT;
INITGRAPH(GD,GM,'d:\tp\BGI');
IF (GRAPHRESULT <> GROK) THEN
BEGIN
WRITELN('Loi khoi tao do hoa !');
READLN;
HALT(1);
END
ELSE
BEGIN
SETCOLOR(LIGHTblue);
RECTANGLE(0,0,GETMAXX-2,GETMAXY-2);
SETTEXTSTYLE(triplexfont,HORIZDIR,1);
SETBKCOLOR(green);
OUTTEXTXY(10,2,'Chuong trinh HeapSort');
VEKHUNG1(A);
SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);

SETCOLOR(WHITE);
K:=60;
FOR I:=1 TO N DO
BEGIN
STR(A[I].GT,S);
OUTTEXTXY(K+I*30,GETMAXY-40,S);
END;
SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,0);
SETCOLOR(RED);
HEAPSORT(A,N);
SETTEXTSTYLE(2,HORIZDIR,5);
SETCOLOR(red);
OUTTEXTXY(20,GETMAXY-90,'Ket qua cua chuong trinh Heapsort ');
SETCOLOR(white);
SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
OUTTEXTXY(20,GETMAXY-40,'In put : ');
OUTTEXTXY(20,GETMAXY-20,'Out put: ');
SETCOLOR(WHITE);
K:=60;
FOR I:=1 TO N DO
BEGIN
STR(A[I].GT,S);
OUTTEXTXY(K+I*30,GETMAXY-20,S);
END;
END;
READLN;
CLOSEGRAPH;
Write (' Continue and pressed [y/n] ');
readln (ch);

Until (ch='N') or (ch='n');
END.*)
Procedure HeapSort;
var so:string[3];
procedure dt;
begin
for i:=1 to n div 2 do
begin
setcolor(14);
line(tamx[i], tamy[i], tamx[2*i], tamy[2*i]);
if 2*iend;
end;
Procedure Heap_sort(var x:mang; p:integer);
var


i:integer;
Procedure SwapDown(var heap:mang; r,n:integer);
var Child:integer; Done:boolean;
begin
done:= false;
child:= 2 * r;
While (not done) and (Child <= n) do
begin
if (child < n) then
if heap[child] < heap[child+1] then
child:=child+1;
if heap[r] < heap[child] then
begin

ch:=readkey;
if ch=#27 then exit
else
begin
tg:=heap[r];
tron(100,150,tg);
xoa(tamx[r],tamy[r],30);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
heap[r]:=heap[child];
tron(tamx[r],tamy[r],heap[r]);
xoa(tamx[child],tamy[child],30);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
heap[child]:=tg;
tron(tamx[child],tamy[child],heap[child] );
xoa(100,150,30);
end;
r:= child; child:= 2 * child;
end
else done:=true;
end;
end;
Procedure Heapify(var heap: mang; n:integer);

var r:integer;


begin
for r:=n div 2 downto 1 do
SwapDown(heap,r,n);
end;
Begin
Heapify(x,n);
for i:=n downto 2 do
begin
ch:=readkey;
if ch=#27 then exit
else
begin
tg:=x[1];
tron(100,150,tg);
xoa(tamx[1],tamy[1],30);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
x[1]:=x[i];
tron(tamx[1],tamy[1],x[1]);
xoa(tamx[i],tamy[i],30);
end;
ch:=readkey;
if ch=#27 then exit
else

begin
x[i]:=tg;
tron(tamx[i],tamy[i],x[i]);
xoa(100,150,30);
begin
sound(1047);delay(150); nosound;
str(x[i],so);
setcolor(15);
outtextxy(400,320,'Ngat '+so+' ra khoi cay.');
end;
ch:=readkey;
if ch=#27 then exit
else
begin
xoa(tamx[i],tamy[i],x[i]);
setcolor(1);
xoa(tamx[i div 2],tamy[i div 2],x[i div 2]);
line(tamx[i],tamy[i],tamx[i div 2], tamy[i div 2]);


tron(tamx[i div 2],tamy[i div 2],x[i div 2]);
setcolor(1);
outtextxy(400,320,'Ngat '+so+' ra khoi cay.');
setcolor(15);
end;
end;
tamy[i]:=400;
tamx[i]:=i*62-35;
tron(tamx[i],tamy[i],x[i]);
Swapdown(x,1,i-1);

end;
ch:=readkey;
if ch=#27 then exit
else
xoa(tamx[1],tamy[1],x[1]);
tron(62-35,400,x[1]);
end;
Begin
for i:=1 to n do Item[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,20,'Day la kieu sap xep HEAP SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
tamx[1]:=400;tamy[1]:=90;
for i:=2 to 3 do begin tamx[i]:=i*220-140; tamy[i]:=150; end;
for i:=4 to 7 do begin tamx[i]:=i*120-260; tamy[i]:=220; end;
for i:=8 to n do begin tamx[i]:=(i-1)*100-550;tamy[i]:=320; end;
dt; for i:=1 to n do tron(tamx[i],tamy[i],Item[i]);
ch:=readkey;
if ch=#27 then exit
else
begin
Heap_sort(Item, n);
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);

outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
end;
End;


(*==========================================================
=====*)
Procedure Mergesort;
Procedure Merge_Sort(l,r:integer);
Var t,i,j,k,m:integer;
Begin
setbkcolor(1);
If r-l > 0 then
Begin
m:= (r+l) div 2;
Merge_Sort(l,m); Merge_Sort(m+1,r);
For i:= m downto l do b[i]:= c[i];
For j:= m+1 to r do b[r+m+1-j]:= c[j];
For k:= l to r do
begin
delay(1000);
tron(100,200,c[k]);
xoa(tamx[k],tamy[k],31);
If b[i] < b[j] then
Begin
delay(1000);
xoa(tamx[i],tamy[i],31);
tron(tamx[i],tamy[i],c[k]);

c[k]:= b[i];
tron(tamx[k],tamy[k],b[i]);
xoa(tamx[i],tamy[i],31);
i:= i+1;
End
Else
Begin
delay(1000);
xoa(tamx[j],tamy[i],31);
tron(tamx[j],tamy[i],c[k]);
c[k]:= b[j];
tron(tamx[k],tamy[k],b[j]);
xoa(tamx[j],tamy[j],31);
j:= j-1;
End;
delay(1000);
xoa(100,200,31);
End;
End;
for t:= 1 to n do tron(tamx[t],tamy[t],c[t]);
delay(1000);


End;
Begin
for i:=1 to n do c[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);

outtextxy(160,40,'Day la kieu sap xep MERGE SORT');
settextstyle(0,0,0);
for i:= 1 to n do
begin
tamy[i]:=340;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],c[i]);
end;
delay(1000);
Merge_Sort(1,n);
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
Readln;
End;
(*==========================================================
=======*)
procedure obj.Move(n,x1,y1,x2,y2,h:integer;b:boolean;
nd:bangkt;mnc,mcc,mnr,mcr:integer;var chon:integer);
var
ch1,ch2:char;
chonm,i:integer;
mn,mc,dai,d,dau:integer;
procedure menu(x1,y1,x2,y2:integer;dkt:strn;h,mn,mc:integer);
var
nd:bangkt;
i,x:integer;
begin
setcolor(mc);
bar3d(x1,y1,x2,y2,h,true);
setfillstyle(1,mc);

floodfill(round((x1+x2)/2), round((y1+y2)/2),mc);
setcolor(mn);
x:= round((x2-x1) div 2);
x:= (x-length(dkt)) div 2 -15;
outtextxy(x1+x,round((y1+y2)/2),dkt);
for i:=1 to h do
begin


line(x1+i,y1-i,x2+i,y1-i);
line(x2+i,y1-i,x2+i,y2-i);
end;
end;
begin
Cleardevice;
if (n<=0) or (n>20) then exit;
chon:=1;
chonm:=chon;
for i:=1 to n do
begin
menu(x1,y1,x2,y2,nd[i],h,mnc,mcc);
dai:=y2-y1;
y1:=y2+5;
y2:=y1+dai;
setcolor(15);
settextstyle(4,0,2);
outtextxy(180,420,'Mot so phuong phap sap xep.');
settextstyle(0,0,0);
end;
y2:=y2-n*(dai+5);

y1:=y1-n*(dai+5);
menu(x1,round(y1),x2,round(y2),nd[chonm],h,mnr,mcr);
setcolor(15);
settextstyle(4,0,2);
outtextxy(180,420,'Mot so phuong phap sap xep.');
settextstyle(0,0,0);
while ch1 <> #13 do
begin
ch1:=readkey;
if ch1=#27 then
begin
cleardevice;
obj.bye;
halt;
end;
if ch1=#0 then
begin ch2:=readkey;
if ch2=#72 then
begin
chonm:= chon-1;
if chonm <= 0 then chonm:= n;
end
else
if ch2=#80 then


begin
chonm:=chon+1;
if chonm>n then chonm:=1;
end;

if chonm<>chon then
begin
menu(x1,y1+(chon-1)*(dai+5),x2,y2+(chon-1)*(dai+5),nd[chon],h,mnc,mcc);
menu(x1,y1+(chonm-1)*(dai+5),x2,y2+(chonm-1)*(dai+5),nd[chonm],h,mnr,mcr);
setcolor(15);
settextstyle(4,0,2);
outtextxy(180,420,'Mot so phuong phap sap xep.');
settextstyle(0,0,0);
chon:=chonm;
end;
end;
end;
ok:= true;
setcolor(15);
settextstyle(4,0,2);
outtextxy(180,420,'Mot so phuong phap sap xep.');
settextstyle(0,0,0);
end;
(*==========================================================
====*)
procedure H_hop(x1,y1,x2,y2:integer;h:integer;mn,mc:integer);
var
nd:bangkt;
i,x:integer;
begin
setcolor(mc);
bar3d(x1,y1,x2,y2,h,true);
floodfill(round((x1+x2)/2),round((y1+y2)/2),mc);
end;
(*==========================================================

=====*)
procedure obj.Bye;
var
i:integer;
begin
cleardevice;
setbkcolor(black);
settextstyle(4,0,3);
setcolor(11);


outtextxy(150,210,'GOOBYE, SEE YOU AGAIN !');
Delay(1700);
end;
(*==========================================================
======*)
procedure obj.Menuchinh;
begin
Setbkcolor(Blue);
Phim[1]:=' Selection Sort ';
Phim[2]:=' Insertion Sort ';
Phim[3]:=' Bubble Sort ';
Phim[4]:=' Shell Sort ';
Phim[5]:=' Quick Sort ';
Phim[6]:=' Heap Sort ';
Phim[7]:=' Merge Sort ';
Phim:=' Exit ';
while (chon<>8) do
begin
obj.Move(8,230,80,380,110,4,true,phim,3,7,yellow,green,chon);

if chon=1 then Selection;
if chon=2 then Insertion;
if chon=3 then Bubble;
if chon=4 then Shellsort;
if chon=5 then Quick;
if chon=6 then Heapsort;
if chon=7 then Mergesort;
if (chon=8) and (ok) then
begin
cleardevice;
obj.bye;
end;
H_hop(10,10,getmaxx-10,getmaxy-10,4,red,toi);
end;
end;
(*==========================================================
======*)
BEGIN
Gd:= detect;
Initgraph(gd,gm,'D:\Tp\Bgi');
Setbkcolor(1);
Gioi_thieu;
Closegraph; Nhap;
Initgraph(gd, gm, 'D:\Tp\Bgi');


Setbkcolor(1);
Ob_ject.Menuchinh;
Closegraph; readln;
END.