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

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];

{---------------------------------------------------------------------------------}
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

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;

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;

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);

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

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


Nhờ tải bản gốc
Music ♫

Copyright: Tài liệu đại học © DMCA.com Protection Status