Bài giảng Giáo trình pascal

USES CRT;
CONST MaxLength=50; {do dai danh sach}
TYPE Elementtype = Integer; {kieu phan tu trong DS}
Position = Integer; {kieu vi tri cac phan tu}
List= record
{mang chua cac phan tu cua danh sach}
Element: Array[1..MaxLength] of Elementtype;
Last : Integer; { giu do dai danh sach }
End;
{------------------------------------------------------------------}
Procedure Makenull_List(var L: List);
begin
L.Last:=0;
end;
Function Empty_List(L : List ) : Boolean;
Begin
Empty_List:=(L.Last=0);
End;
{------------------------------------------------------------------}
Procedure Insert_List(X:Elementtype; P:Position; var L: List);
Var q:Position;
Begin
If L.last>=MaxLength Then Writeln('Loi : danh sach day ')
Else
If (p>L.Last+1) or (p<1) Then
Writeln('Loi: vi tri khong hop le ')
Else
Begin
{doi cac phan tu tu vi tri P den cuoi danh sach xuong 1 vi tri }
For q:=L.Last Downto p Do
L.Element[q+1]:=L.Element[q];

L.Last:=L.Last+1; {do dai tang len 1}
L.Element[p]:=X; {dat vao vi tri P}
End;
End;
{-----------------------------------------------------------------------------------------}
procedure Delete_List(P:Position ; var L:List);
Var q:Position;
Begin
If (p>L.last) or (p<1) then
writeln('Loi : vi tri cua phan tu xoa khong hop le ')
Else
Begin
{doi cac phan tu tu vi tri P+1 den cuoi danh sach len 1 vi tri }
For q:=p+1 to L.Last do
L.Element[q-1]:=L.Element[q];
L.Last:=L.Last-1;
End;
End;
{-------------------------------------------------------------------------------}
Function End_List(L: List) : Position;
Begin
End_List:=L.Last+1;
End;
{--------------------------------------------------------------------------------}
Function Next(p:Position; L: List) : Position;
Begin
If (p>L.Last) or (p<1) Then
writeln('Khong xac dinh ')
Else Next:=p+1;
End;

{---------------------------------------------------------------------------------}
Function Previous (p:Position; L: List) : Position;
Begin
If (p>L.Last+1) or (p<2) Then
writeln('Khong xac dinh ')
Else Previous:=p-1;
End;
{---------------------------------------------------------------------------------}
Procedure Read_List(var L:List);{Nhap so lieu cho danh sach}
Var
i,n:integer;
X: ElementType;
Begin
Makenull_List(L);
gotoxy(10,6);Write('Nhap vao so luong phan tu cua mang:');Readln(n);
For i:=1 to n do
Begin
Gotoxy(10,6+i); Write('Nhap phan tu thu ',i,' : ');
Readln(X);
Insert_List(X,End_List(L),L);
end;
end;
Procedure Read_List1(var L:List;h:word);{Nhap so lieu cho danh sach}
Var
i,n:integer;
X: ElementType;
Begin
Makenull_List(L);
gotoxy(10,h);Write('Nhap vao so luong phan tu cua mang:');Readln(n);
For i:=1 to n do

Begin
Gotoxy(10,h+i); Write('Nhap phan tu thu ',i,' : ');
Readln(X);
Insert_List(X,End_List(L),L);
end;
end;
{----------------------------------------------------------------------------------}
Procedure Print_List(L:List;n:Word);{Xuat danh sach }
Var
i:integer;
Begin
if (not Empty_List(L)) then
for i:=1 to L.Last do
write(L.Element[i]:n)
else
write('* Danh sach rong');
writeln;
End;
{-------------------------------------------------------------------------------------------------------------}
Procedure KT(L:List;Var n:integer);
Var i:integer;
Begin
i:=1;
While (L.Element[i]<=L.Element[i+1])and(i<L.Last) do
i:=i+1;
n:=i;
End;
Procedure Insert (L:List;Var L1:List;n:position);{Them mot node vao dau, giua, cuoi danh sach}
Var i,y:integer;
Begin

L1:=L;
Case n of
1:Begin
Begin
Write('Nhap vao gia tri phan tu muon them vao:');Readln(y);
Insert_List(y,1,L1);
End;
End;
2:Begin
Write('Nhap vao gia tri phan tu muon them vao:');Readln(y);
Insert_List(y,L1.Last+1,L1);
End;
3:Begin
Write('Nhap vao gia tri phan tu muon them vao:');Readln(y);
i:=L1.Last div 2;
Insert_List(y,i+1,L1);
End;
End;
End;
{------------------------------------------------------------------------------------------------}
Procedure Delete (L:List;Var L1:List;P:Word);{Xoa 1 nut o dau, giua, cuoi danh sach}
Var i:integer;
Begin
L1:=L;
Case p of
1:Delete_List(1,L1);
2:Delete_List(L1.Last,L1);
3:Begin i:=(L1.Last+1) div 2;Delete_List(i,L1);End;
End;
End;

{------------------------------------------------------------------------------------------------}
Procedure Tim(x,y:word;L:List;Var L1:List;h:integer);
Var i:integer;
Begin
MakeNull_List(L1);
gotoxy(x,y);Print_List(L,14);Delay(3000);
For i:=1 to L.Last do
Begin
If L.Element[i]<>h then
Begin
Textcolor(4);
gotoxy(x+i*14-2,y); Write('[',L.Element[i],']<>',h,';VT=',i);Delay(5000);
Textcolor(7);
gotoxy(x+i*14-2,y); Write(' ',L.Element[i],' ');
End;
If L.Element[i]=h then
Begin
Textcolor(blue);
gotoxy(x+i*14-2,y); Write('[',L.Element[i],']=',h,';VT=',i);Delay(3000);
Textcolor(7);
Insert_List(i,End_List(L1),L1);
gotoxy(x+L1.Last*4,y+2); Write(L1.Element[L1.Last]);
gotoxy(x+i*14-2,y); Write(' ',L.Element[i],' ');
End;
End;
If L1.Last=0 then
Begin
Writeln;Writeln;Writeln;Writeln;Writeln;
Writeln('Gia tri ',h,' khong ton tai trong mang');
End;

End;
{--------------------------------------------------------------------------------------------}
Procedure sapxep1(var L1:list;L:List);
var i,j,t:integer;
Begin
L1:=L;
for i:=1 to End_List(L1)-2 do
for j:=i+1 to End_list(L1)-1 do
if L1.element[j]<L1.element[i] then
begin
t:=L1.element[j];
L1.element[j]:=L1.element[i];
L1.element[i]:=t;
end;
end;
{---------------------------------------------------------------------------------------------}
Procedure Giao(L1,L2:list;var L3:list);
Var i,k,j,t,h:integer;
begin
Makenull_List(L3);
for i:=1 to End_list(L1)-1 do
for j:=1 to End_List(L2)-1 do
if L1.element[i]=L2.element[j] then
insert_list(L2.element[j],End_List(L3),L3);
k:=1;
j:=End_List(L3);
while k<j-2 do
Begin
t:=End_List(L3);
h:=k;

While h<t-1 do
if L3.Element[k]=L3.Element[h+1] then
Begin
Delete_List(h+1,L3);
t:=End_List(L3);
h:=h;
End else h:=h+1;
j:=t;
k:=k+1;
End;
End;
{---------------------------------------------------------------------------------------}
Procedure AHieuB(x,y:Word;L1,L2:List;Var L:List);
Var i,j,k,h:Word;
Begin
gotoxy(x,y);Print_List(L1,8);
Gotoxy(x,y+1);Print_List(L2,8);
MakeNull_List(L);
For i:=1 to L1.Last do
Begin
gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');delay(2000);
j:=1;
While (j<End_List(L2))And(L1.Element[i]<>L2.Element[j]) do
Begin
gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');delay(1000);
gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' ');
j:=j+1;
End;
IF L1.Element[i]=L2.Element[j] then
Begin

gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');Delay(2000);
gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' ');
TextColor(4);
gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');
TextColor(7);
End;
if j= End_List(L2) then
Begin
TextColor(blue);
gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');
TextColor(7);
Insert_List(L1.Element[i],End_List(L),L);
gotoxy(x+L.Last*8-2,y+3);Write(L.Element[L.Last]);
End;
End;
End;
{-----------------------------------------------------------------------------------}
Procedure DoHoaGhep(x,y:Word;L1,L2:List;Var L:List);
Var i,h:integer;
Begin
L:=L1;
i:=1;
gotoxy(x,y);Print_List(L2,8);
Gotoxy(x,y+1);Print_List(L,8);
While i<=L2.Last do
Begin
gotoxy(x+i*8-2,y); Write('[',L2.Element[i],'] ');delay(2000);
if i<L1.Last then
Begin
TextColor(4);

gotoxy(x+i*2*8-2,y+1); Write('[',L.Element[i*2],']');
gotoxy(x+(i*2-1)*8-2,y+1); Write('[',L.Element[i*2-1],']');Delay(2000);
TextColor(7);
gotoxy(x+i*2*8-2,y+1); Write(' ',L.Element[i*2],' ');
gotoxy(x+(i*2-1)*8-2,y+1); Write(' ',L.Element[i*2-1],' ');
h:=L.Last+1;
While h<>i*2 do
Begin
gotoxy(x+(h-1)*8-1,y+1); Write(L.Element[h-1],'->');Delay(3000);
gotoxy(x+h*8-1,y+1); Write(L.Element[h-1],' ');
gotoxy(x+(h-1)*8-1,y+1); Write(L.Element[h-1],' ');h:=h-1;
End;
gotoxy(x+h*8-1,y+1); Write(L2.Element[i],' ');
Insert_List(L2.Element[i],2*i,L)
End
Else
Begin
gotoxy(x+(L.Last+1)*8-1,y+1); Write(L2.Element[i],' ');Delay (1000);
gotoxy(x+i*8-2,y); Write(' ');
Insert_List(L2.Element[i],L .Last+1,L);
End;
i:=i+1;
End;
End;
{-----------------------------------------------------------------------------------}
Procedure TextList(L:List);
Var i:integer;
Begin
i:=1;
While (L.Element[i]<=L.Element[i+1])and(i<L.Last) do

i:=i+1;
If i=L.Last then
Write('Mang da duoc sap xep') Else
Writeln('Mang chua duoc sap xep');
End;
{----------------------------------------------------------------------------------}
Procedure XPTT(L:List;Var L1:List);
Var i,j:integer;
Begin
L1:=L;
i:=1;
While i<=L1.Last-1 do
Begin
j:=i+1;
While j<=L1.Last do
If L1.Element[i]=L1.Element[j] then
Begin
Delete_List(j,L1);
j:=j;
End
Else
j:=j+1;
i:=i+1;
End;
End;
{--------------------------------------------------------------------------------------}
{--------------------------------------------------------------------------------------}
Procedure SumList(L:List);
Var s,i:integer;
Begin

s:=0;
For i:=1 to L.Last do
S:=s+L.Element[i];
Writeln('Tong cua mang la:',s);
End;
{-----------------------------------------------------------------------------------------}
Procedure VeND(x,y,n,mc:byte;ch,k:char);
Var i:byte;
Begin
Gotoxy(x,y);
textcolor(mc);
Case k of
'N':Begin
For i:=1 to n do
Write(ch:2);
End;
'D':Begin
For i:=1 to n do
Begin
Gotoxy(x,y+i);
Write(ch);
End;
End;
End;
Textcolor(7);
End;
{-------------------------------------------------------------------------------}
Procedure MCTD(x,y,mc,mn:byte;nd:string);
Begin
Gotoxy(x,y);

TextBackground(mn);
textcolor(mc);
Write(nd);
textbackground(0);
Textcolor(7);
End;
{-----------------------------------------------------------------------------------------}
Procedure CC(x,y,mc,mn,td:byte;nd:string);
Var i:byte;
Begin
For i:=1 to length(nd) do
Begin
MCTD(x+i,y,mc,mn,nd[i]);
delay(td);
End;
End;
{-----------------------------------------------------------------------------------------}
Procedure CG(x,y,mc,mn,t:byte;nd:String);{Chay giua}
var st:string;
i,j,l,giua,x1,x2:byte;
begin
st:=nd;
l:=length(nd);
x1:=x;
y:=y;
x2:=x1+l-1;
giua:=(l+1)div 2;
for i:=giua downto 1 do
begin
for j:=1 to i do

begin
MCTD(x1+j-1,y,2,7,st[i]);
MCTD(x2-j+1,y,2,7,st[l-i+1]);
delay(t);
MCTD(x1+j-1,y,2,7,' ');
MCTD(x2-j+1,y,2,7,' ');
end;
MCTD(x1+j-1,y,2,0,st[i]);
MCTD(x2-j+1,y,2,0,st[l-i+1]);
end;
end;
{------------------------------------------------------------------------------}
Procedure DoHoaGiao(x,y:Word;L1,L2:List;Var L:List);
Var i,j,k,h:Word;
Begin
gotoxy(x,y);Print_List(L1,8);