Program BAI_TAP_CHU_DE_LON1;
Uses Dos,Crt,graph;
Type mang = array [1..10] of string;
m1 = array [1..21] of byte;
Const
dong = 10;
old = 15;
tg = 60000;
MAU=159;
mau2=120;
Var
k:array[1..10] of string;
dc:char;
Gd,Gm : Integer;
Radius,T : Integer;
a : m1;
f1,f2:m1;
n,l,i,h1,h2,p,pm : byte;
ss,hv : word;
Procedure ConTro(co:byte);
Var R : Registers;
Begin
R.AH:=$01;
If co = 0 Then R.CX:=$2000
Else R.CX:=$0B0C;
Intr($10,R);
End;
Procedure writeXYso(x,y,tt,i:byte);
Begin
textattr:=tt;
gotoxy(x,y-1);write('ÚÄÄ¿');
ConTro(1);
write('Nhap vao so phan tu : ');readln(n);
for i:=1 to n do
begin
gotoxy(5,18);write('Nhap vao phan tu thu ',i,' : ');readln(a[i]);
xuat1(a,i);
gotoxy(5,18);write(' ');
end;
ConTro(0);
end;
Procedure writeXYchuoi(x,y:byte;chuoi:string;tt:byte);
Begin
gotoxy(x,y);
textattr:=tt;
write(chuoi);
textattr:=old;
End;
Function TaoMenu(x,y,max:byte;tieude:mang):byte;
Var chon : byte;
kt : char;
Begin
For chon:=1 to max do
writexychuoi(x,y+chon,tieude[chon],old);
chon:=1;
Repeat
writexychuoi(x,y+chon,tieude[chon],31);
kt:=readkey;
if kt=#0 then kt:=readkey;
writexychuoi(x,y+chon,tieude[chon],old);
case kt of
End;
Procedure Xoa(x,y:byte);
Begin
gotoxy(x,y-1);write(' '); {1}
gotoxy(x,y);write(' ');
gotoxy(x,y+1);write(' ');
End;
{--------------------------HVi---------------------------------------}
Procedure HVi(var i,j:byte);
Var x,coti,dongi,cotj,dongj : byte;
Begin
coti:=i*4-3;
cotj:=j*4-3;
writexyso(coti,dong,159,i);
writexyso(coti,dong,159,j);
delay(tg);
xoa(coti,dong);
xoa(cotj,dong);
dongi:=dong-3;
dongj:=dong+3;
WriteXYso(coti,dongi,159,i);
WriteXYso(cotj,dongj,159,j);
delay(tg);
While (coti<>j*4-3)or(cotj<>i*4-3) do
begin
xoa(coti,dongi);xoa(cotj,dongj);
if i<j then begin coti:=coti+4;cotj:=cotj-4;end
else begin cotj:=cotj+4;coti:=coti-4;end;
writexyso(coti,dongi,159,i);writexyso(cotj,dongj,159,j);delay(tg);
end;
HVi(min,i);
end;
writexychuoi(24,12,' Day da duoc sap xep xong',14);
gotoxy(24,24);
write('Nhan ENTER de tiep tuc...');
readln;
End;
{------------------------------NHO--------------------------------}
Function nho(x,j:byte):boolean;
Begin
nho:=x<a[j]; {<}
writexyso(j*4-3,dong,207,j);delay(tg);
writexyso(j*4-3,dong,old,j);delay(tg);
inc(ss);
gotoxy(1,18);writeln('So lan so sanh : ',ss);
End;
{---------------------Chen truc tiep (Insertion Sort)--------------}
Procedure Insertionsort (var a:m1;n:byte);
Var i,j,k,x : byte;
thoat : boolean;
Begin
Writexychuoi(28,5,'Chen Truc Tiep (Insertion Sort)',14);
clr;
For i:=1 to n do writexyso(i*4-3,dong,15,i);
For i:=2 to n do
begin
a[n+1]:=a[i];
writexyso(i*4-3,dong,159,i);delay(tg);
xoa(i*4-3,dong);
writexyso(i*4-3,dong-3,159,i);
Procedure BubleSort(var a:m1;n:byte);
Var i,j,k : byte;
Begin
Writexychuoi(28,5,'Sap xep noi bot (Buble Sort) ',14);
clr;
For i:=1 to n do writexyso(i*4-3,dong,old,i);
For i:=2 to n do
For j:=n downto i do
begin
k:=j-1;
if Nhohon(j,j-1) then HVi(j,k);
end;
writexychuoi(24,12,'Day da duoc sap xep xong',14);
gotoxy(24,24);
write('Nhan ENTER de tiep tuc...');
readln;
End;
{-----------------------Sap xep vun dong(HeapSort)--------------------}
Procedure HeapSort(var a:m1;n:byte);
Var L,R,tam,i : Byte;
procedure Sift(L,R:Byte);
var i,j,x,k,m : byte;
cont : boolean;
begin
i:=L;
cont:=True;
j:=2*i; { j va j+1 la 2 phan tu lien doi voi i }
x:=a[i];
a[n+1]:=x;
m:=i;
if m<>i then
begin
for k:=m+1 to i do
begin
writexyso(k*4-3,dong-3,207,n+1);delay(tg);
xoa(k*4-3,dong-3);delay(tg);
end;
writexyso(i*4-3,dong,207,n+1);delay(tg);
writexyso(i*4-3,dong,old,n+1);delay(tg);
end;
a[i]:=x;
end;
xoa(m*4-3,dong-3);delay(tg);
End;
Begin