bai tap phan 5tt

(---------------------------------------Begin----------------------------------)
Program Dong;
Uses Crt;
CONST
Max = 100;
TYPE
Str = String[255];
Mang = Array[1..Max] Of Str;
VAR
Cau,Cau1,Cu,Moi : Str;
T : Mang;
i,SoT,Chon : Integer;
{---------------------------------------}
Procedure Tach(Var S : Str; Var T : Mang; Var SoT : Integer);
Var
i,j,k,l : Integer;
Begin
k := 1;
i := 1;
l := Length(S);
While ( i <= l) Do
Begin
While (S[i] = ' ') And (i <= L) Do
i := I +1;
j := 1;
While (S[i] <> ' ') And (i <= l) Do
Begin
T[k][j] := S[i];
j := j +1;
i := i +1;
End;
T[k][0] := Chr(j-1);
k := k + 1;
End;
SoT := k - 1;
End;
{---------------------------------------}
Procedure Nen(Var S : Str);
Var
i,j,l,z,xoa : Integer;
Begin
i := 1;
j := 1;
l := Length(S);
Xoa := 0;
While i <= l Do
Begin
z := i;
While (S[i] = ' ') And ( i <= l) Do
i := i + 1;
Xoa := Xoa +i - z;
While (S[i] <>' ') And ( i <= l ) Do
Begin
S[j] := S[i];
i := i + 1;
j := j + 1;
End;
End;
S[0] := Chr(l - Xoa);
End;
{---------------------------------------}
Procedure Nen2(Var S : Str);
Var
i,j,l,z : Integer;
Begin
i := 1;
l := Length(S);
While i <= l Do
Begin
While (S[i] = ' ') And ( i <= l) Do
i := i + 1;
z := i;
While (S[i] =' ') And ( i <= l ) Do
i := i + 1;
Delete(S,z,i-z);
i := z;
End;
End;
{---------------------------------------}
Procedure Thay(Var S : Str; Sold, Snew : Str);
Var
Lo,Ln,LDu,p : Integer;
St,Sdu : Str;
Begin
Lo := Length(Sold);
Ln := Length(Snew);
St :=' ';
Sdu := S;
P := Pos(Sold,Sdu);
While P <> 0 Do
Begin
Ldu :=Length(Sdu);
St := St + Copy(Sdu,1,P-1) + Snew;
Delete(Sdu,1,P-1+Lo);
P := Pos(Sold, Sdu);
End;
S := St + Sdu;
End;
{---------------------------------------}
BEGIN
ClrScr;
Write('Nhap Cau : ');
Readln(Cau);
While Cau <> ' ' do
Begin
Writeln(' 1.Tach cau');
Writeln(' 2.Nen cau');
Writeln(' 3.Thay the');
Writeln(' 0.Ket thuc');
Writeln;
Write(' Chon : ');
Readln(Chon);
Case Chon Of
1 : Begin
Tach(Cau,T, SoT);
For i := 1 To SoT Do
Writeln(T[i]);
End;
2 : Begin
Cau1 := Cau;
Nen(Cau1);
Writeln(Cau1);
End;
3 : Begin
Cau1 :=Cau;
Repeat
Write('+Muon thay: ');
Readln(Cu);
Until Cu <> ' ';
Write('+ Bang : ');
Readln(Moi);
Thay(Cau1,Cu,Moi);
Writeln(Cau1);
End;
0 : Exit;
End;
End;
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+_+_+__+_+_)))))
(---------------------------------The End--------------------------------------)
Program Hoan_Vi_Chuoi;
Uses Crt;
VAR
Chuoi1,Chuoi2,Tam :^String;
Begin
ClrScr;
Writeln('HOAN VI 2 CON TRO THAY CHO HOAN VI NOI DUNG');
Writeln('-------------------------------------------');
Writeln;
New(Chuoi1);
New(Chuoi2);
Chuoi1^ := 'Giao trinh Turbo Pascal 7.0';
Chuoi2^ := 'Giao trinh FoxPro 2.6';
Writeln;
Writeln('NOI DUNG BAN DAU CUA 2 CHUOI');
Writeln('----------------------------');
Writeln;
Writeln('-Chuoi thu nhat: ',Chuoi1^);
Writeln('-Chuoi thu hai : ',Chuoi2^);
Writeln;
Writeln('NOI DUNG SAU KHI HOAN VI 2 CON TRO');
Writeln('----------------------------------');
Writeln;
Tam := Chuoi1;
Chuoi1 := Chuoi2;
Chuoi2 := Tam;
Writeln('-Chuoi thu nhat: ',Chuoi1^);
Writeln('-Chuoi thu hai : ',Chuoi2^);
Dispose(Chuoi1);
Dispose(Chuoi2);
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
End.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+_+_+__++_+__)))
(---------------------------------The End-------------------------------------)
Program So_ngau_Nhien;
Uses Crt;
CONST
N = 100;
VAR
Mang : Array[1..N] Of ^Word;
HeapTop : Pointer;
{-------------------------------}
Procedure TaoSo;
Var
i : Byte;
Begin
Randomize;
For i := 1 To N Do
Begin
New(Mang[i]);
Mang[i]^ := Random(999);
End;
End;
{-------------------------------}
Procedure SapXep;
Var
i : Byte;
Tam : Word;
KetThuc : Boolean;
Begin
Repeat
KetThuc := True;
For i := 1 To n-1 Do
If Mang[i]^ > Mang[i+1]^ Then
Begin
Tam := Mang[i]^;
Mang[i]^ := Mang[i+1]^;
Mang[i+1]^ := Tam;
KetThuc := False;
End;
Until ketThuc;
End;
{-------------------------------}
Procedure InKq;
Var
i :Byte;
Begin
For i := 1 To N Do
Write(Mang[i]^:4);
End;
{-------------------------------}
BEGIN
ClrScr;
Writeln(' TAO VA SAP XEP THU TU 100 SO NGAU NHIEN');
Writeln(' ---------------------------------------');
Writeln;
Mark(HeapTop);
TaoSo;
SapXep;
Inkq;
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
Release(HeapTop);
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Mang_Bien_Dong;
Uses Crt;
TYPE
ConTro = ^BanGhi;
BanGhi = RECORD
HoTen : String[24];
Next : ConTro;
End;
VAR
First, Last, P : ConTro;
HeapTop : Pointer;
i : Byte;
Ch : Char;
{-------------------------------}
Procedure KhoiTao;
Begin
First := Nil;
Mark(HeapTop);
i := 0;
Writeln('NHAP DU LIEU');
Writeln('Khong nhap nua thi bam <Enter> ...');
Repeat
Inc(i);
New(P);
Write('-Ho ten nguoi thu: ',i:2,' : ');
Readln(P^.HoTen);
If First = Nil Then
First := P
Else
Last^.Next := P;
Last := P;
Last^.Next := Nil;
Until P^.HoTen = ''
End;
{-------------------------------}
Procedure LietKe;
Var
Q : ConTro;
Begin
Q := First;
i := 0;
While Q <> Nil Do
Begin
Inc(i);
Writeln(i:2,' >..: ',Q^.HoTen:-24);
Q := Q^.Next;
End;
End;
{-------------------------------}
Procedure Xoa(N : Byte);
Var
k : Byte;
Q : ConTro;
Begin
If N = 1 Then
First := First^.Next
Else
Begin
Q := First;
For k := 1 To N-2 Do
Q := Q^.Next;
Q^.Next := Q^.Next^.Next;
End;
End;
{-------------------------------}
Procedure Chen(N : Byte);
Var
k : Byte;
Q : ConTro;
Begin
If N <= 0 Then
Exit;
New(P);
Write('-Ho Ten muon chen: ');
Readln(P^.HoTen);
If N = 1 Then
Begin
P^.Next := First;
First := P;
End
Else
Begin
Q := First;
For k := 1 To N-2 Do
Q := Q^.Next;
P^.Next := Q^.Next;
Q^.Next := P;
End;
End;
{-------------------------------}
BEGIN
ClrScr;
Writeln('Bo nho hien gio la: ',MemAvail);
KhoiTao;
Writeln;
Write(' Bam <Enter> de xem danh sach ... ');
Readln;
LietKe;
Writeln;
Writeln('Bo nho hien gio la: ',MemAvail);
Write(' Bam <Enter> de xoa danh sach ... ');
Readln;
Repeat
Write('-Muon xoa ban ghi thu: ');
Readln(i);
Xoa(i);
LietKe;
Write('+Co xoa nua khong ?(c/k) ');
Readln(Ch);
Until UpCase(Ch) = 'K';
Writeln;
Repeat
Write('-Muon chen ban ghi thu: ');
Readln(i);
Chen(i);
LietKe;
Write('+Co chen nua khong ?(c/k) ');
Readln(Ch);
Until UpCase(Ch) = 'K';
Release(HeapTop);
Writeln;
Writeln('Bo nho hien gio la: ',MemAvail);
Writeln;
Write(' Bam <Enter> . . . ');
Readln
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Tao_Danh_Sach;
Uses Crt;
TYPE
ConTro = ^DanhSach;
DanhSach = RECORD
So : Word;
Next : ConTro;
End;
VAR
First,P,Tam : ConTro;
{----------------------------------}
Procedure KhoiDong;
Begin
First := Nil;
End;
{----------------------------------}
Procedure Nhap;
Var
i : Word;
Begin
Writeln('NHAP CAC SO');
Writeln('Neu khong nhap, go so 0');
i :=0;
Repeat
New(Tam);
Inc(i);
Write('-Nhap so thu: ',i:2,' = ');
Readln(Tam^.So);
Tam^.Next := Nil;
If Tam^.So <> 0 Then
If First = Nil Then
Begin
First := Tam;
P := Tam;
End
Else
Begin
P^.Next := Tam;
P := Tam;
End;
Until Tam^.So =0;
End;
{----------------------------------}
Procedure LietKe;
Begin
Writeln('CAC SO DA NHAP');
Writeln('--------------');
Writeln;
P := First;
While P <> Nil Do
Begin
Write(P^.So:;
P := P^.Next;
End;
End;
{----------------------------------}
Procedure KetThuc;
Begin
If First <> Nil Then
Release(First);
End;
{----------------------------------}
BEGIN
ClrScr;
Writeln('TAO DANH SACH CAC SO NGUYEN');
Writeln('---------------------------');
Writeln;
KhoiDong;
Nhap;
LietKe;
KetThuc;
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Chen_So;
Uses Crt;
CONST
N = 10;
TYPE
ConTro = ^BanGhi;
BanGhi = RECORD
So : Word;
Next : ConTro;
End;
ViTri = 1..n;
VAR
First,P,Tam : ConTro;
V : ViTri;
{----------------------------------}
Procedure KhoiDong;
Begin
First := Nil;
End;
{----------------------------------}
Procedure TaoSo;
Var
i : Byte;
Begin
Randomize;
For i := 1 To n Do
Begin
New(Tam);
Tam^.So := Random($FFFF);
Tam^.Next := Nil;
If i = 1 Then
Begin
First := Tam;
P := Tam;
End
Else
Begin
P^.Next := Tam;
P := Tam;
End;
End;
End;
{----------------------------------}
Procedure Nhap;
Begin
Repeat
Writeln;
Write(' -Cho biet vi tri muon chen: ');
Readln(v);
Until (v >= 1) And (v <=n);
New(Tam);
Writeln;
Write(' -Cho biet gia tri muon chen: ');
Readln(Tam^.So);
End;
{----------------------------------}
Procedure Chen(v : ViTri);
Var
i : Byte;
Begin
If v = 1 Then
Begin
Tam^.Next := First;
First := Tam;
End
Else
Begin
P := First;
For i := 1 To v-2 Do
P := P^.Next;
Tam^.Next := P^.Next;
P^.Next := Tam;
End;
End;
{----------------------------------}
Procedure LietKe;
Begin
P := First;
While P <> Nil Do
Begin
Write(P^.So : 7);
P := P^.Next;
End;
End;
{----------------------------------}
Procedure KetThuc;
Begin
If First <> Nil Then
Release(First);
End;
{----------------------------------}
BEGIN
ClrScr;
Writeln(' NHAP VA CHEN SO VAO VI TRI CHI DINH');
Writeln(' -----------------------------------');
Writeln;
KhoiDong;
TaoSo;
Writeln(' 10 SO TRONG DANH SACH LA: ');
Writeln;
LietKe;
Writeln;
Nhap;
Writeln;
Chen(v);
Writeln;
Writeln(' DANH SACH SAU KHI CHEN');
Writeln;
LietKe;
KetThuc;
Writeln;
Writeln;
Write(' Bam <Enter>... ');
Readln
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End-----------------------------------)
Program Chen_Xoa_So;
Uses Crt;
CONST
N = 20;
TYPE
ConTro = ^BanGhi;
BanGhi = RECORD
So : Word;
Next : ConTro;
End;
ViTri = 1..n;
VAR
First,P,Tam : ConTro;
V : ViTri;
{----------------------------------}
Procedure KhoiDong;
Begin
First := Nil;
End;
{----------------------------------}
Procedure TaoSo;
Var
i : Byte;
Begin
Randomize;
For i := 1 To n Do
Begin
New(Tam);
Tam^.So := Random(10);
Tam^.Next := Nil;
If i = 1 Then
Begin
First := Tam;
P := Tam;
End
Else
Begin
P^.Next := Tam;
P := Tam;
End;
End;
End;
{----------------------------------}
Procedure XoaSo;
Procedure Xoa5;
Begin
Tam := P;
If P = First Then
Begin
First := P^.Next;
P := P^.Next;
End
Else
Begin
P := First;
While P^.Next <> Tam Do
P := P^.Next;
P^.Next := Tam^.Next;
P := P^.Next;
End;
Dispose(Tam);
End;
Begin
P := First;
While P <> Nil Do
Begin
If P^.So < 5 Then
Xoa5
Else
P := P^.Next
End;
End;
{----------------------------------}
Procedure LietKe;
Begin
P := First;
While P <> Nil Do
Begin
Write(P^.So : 5);
P := P^.Next;
End;
End;
{----------------------------------}
Procedure KetThuc;
Begin
If First <> Nil Then
Release(First);
End;
{----------------------------------}
BEGIN
ClrScr;
Writeln(' XOA CA SO NHO HON 5');
Writeln(' -------------------');
KhoiDong;
TaoSo;
Writeln;
Writeln(' 20 SO TRONG DANH SACH LA: ');
Writeln;
LietKe;
Writeln;
XoaSo;
Writeln;
Writeln(' DANH SACH CAC SO >= 5');
Writeln;
LietKe;
KetThuc;
Writeln;
Writeln;
Write(' Bam <Enter>... ');
Readln
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End-------------------------------------)
Program Tach_Danh_Sach;
Uses Crt;
TYPE
Mang = Array[1..100] Of Integer;
VAR
i,j,k,n : Integer;
a,b,c : Mang;
Begin
ClrScr;
Writeln(' NHAP DANH SACH');
Writeln(' --------------');
Write('-So phan tu: ');
Readln(n);
For i := 1 To n Do
Begin
Write('-Phan tu thu: ',i:2,' = ');
Readln(a[i]);
End;
Writeln;
Writeln(' TACH THANH 2 DANH SACH');
Writeln(' ----------------------');
Writeln;
j := 1;
k := 1;
For i := 1 To n Do
If Odd(a[i]) Then
Begin
b[j] := a[i];
j := j + 1;
End
Else
Begin
c[k] :=a[i];
k := k + 1;
End;
Writeln;
Writeln(' -Danh sach thu nhat ( so le ) ');
Writeln;
For i := 1 To j-1 Do
Write(b[i],' ');
Writeln;
Writeln;
Writeln(' -Danh sach thu hai ( so chan ) ');
Writeln;
For i := 1 To k-1 Do
Write(c[i],' ');
Writeln;
Write(' Bam <Enter> . . . ');
Readln
End.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Loai_bo;
Uses Crt;
TYPE
Mang = array[1..100] Of Integer;
VAR
i,Na,Nb,x : Integer;
a: mang;
{--------------------------------------}
Procedure LoaiBo(x : Integer; Var a:mang; Var Na : Integer);
Var
i,j : Integer;
Begin
i := 1;
While i <= Na Do
If (a[i] <> x) Then
i := i + 1
Else
Begin
For j := i To Na - 1 Do
a[j] := a[j+1];
Na := Na - 1;
End;
End;
{--------------------------------------}
Begin
ClrScr;
Writeln(' XOA TRI X TRONG DANH SACH');
Writeln(' --------------------------');
Writeln;
Write('-So phan tu: ');
Readln(Na);
Nb := Na;
For i := 1 To Na Do
Begin
Write('-Phan tu thu: ',i:2,' = ');
Readln(a[i]);
End;
Writeln;
Write('+Phan tu can loai bo: ');
Readln(x);
Loaibo(x,a,Na);
If Na = Nb Then
Writeln('Khong tim thay')
Else
Writeln('Da loai bo');
Writeln;
Writeln('DANH SACH CON LAI');
Writeln('-----------------');
Writeln;
For i := 1 To Na Do
Write(a[i],' ');
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
End.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+_+_++_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Dem_nut;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
So : Integer;
Next : ConTro;
End;
VAR
Nut1,Tam : ConTro;
Ch : Char;
{-------------------------------------}
Function SoNut(Nut1 : ConTro): Integer;
Var
sn : Integer;
Begin
sn := 0;
Tam := Nut1;
While Tam <> Nil Do
Begin
sn := sn + 1;
Tam := Tam^.Next;
End;
SoNut :=sn;
End;
{-------------------------------------}
BEGIN
ClrScr;
Writeln(' DEM SO PHAN TU (NUT) CUA DANH SACH');
Writeln('-----------------------------------');
Writeln;
Nut1 := Nil;
Repeat
New(Tam);
Write('-Nhap so: ');
Readln(Tam^.So);
Tam^.Next := Nut1;
Nut1 := Tam;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch)= 'K';
Writeln('+So nut cua danh sach: ',Sonut(Nut1));
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+_+_++_+_+_)))))
(---------------------------------The End-------------------------------------)
Program Dem_Nut_Cuoi;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
So : Integer;
Next : ConTro;
End;
VAR
Nut1,Tam : ConTro;
Ch : Char;
{-------------------------------------}
Function DemNutCuoi(Nut1 : ConTro): ConTro;
Begin
Tam := Nut1;
While Tam^.Next <> Nil Do
Tam:= Tam^.Next;
DemNutCuoi := Tam;
End;
{-------------------------------------}
BEGIN
ClrScr;
Writeln('TIM DIA CHI NUT CUOI');
Writeln('--------------------');
Writeln;
Nut1 := Nil;
Repeat
New(Tam);
Write('-Nhap so: ');
Readln(Tam^.So);
Tam^.Next := Nut1;
Nut1 := Tam;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch)= 'K';
Writeln('+So o nut cuoi cua danh sach: ',DemNutCuoi(Nut1)^.So);
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____++++++++++______+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Trung_Binh;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
So : Integer;
Next : ConTro;
End;
VAR
Nut1,Tam : ConTro;
Ch : Char;
{-------------------------------------}
Function Tbc(Nut1 : ConTro): Real;
Var
Tong,SoNut : Integer;
Begin
Tong := 0;
SoNut := 0;
Tam := Nut1;
While Tam <> Nil Do
Begin
SoNut := SoNut + 1;
Tong := Tong + Tam^.So;
Tam := Tam^.Next;
End;
Tbc := Tong / SoNut;
End;
{-------------------------------------}
BEGIN
ClrScr;
Writeln(' TINH TRI TRUNG BINH CONG');
Writeln(' ------------------------');
Nut1 := Nil;
Repeat
New(Tam);
Write('-Nhap so: ');
Readln(Tam^.So);
Tam^.Next := Nut1;
Nut1 := Tam;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch)= 'K';
Writeln('+Trung binh cong cua danh sach: ',Tbc(Nut1):6:1);
Writeln;
Write(' Bam <Enter> . . . ');
Readln;
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++___+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End-------------------------------------)
Program Chen_Xoa;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
So : Integer;
Next : ConTro;
End;
VAR
Nut1,Tam : ConTro;
So1 : Integer;
Ch : Char;
{-------------------------------------}
Procedure Chen(Var Nut1 : ConTro; So1 : Integer);
Begin
New(Tam);
Tam^.So :=So1;
Tam^.Next := Nut1;
Nut1 := Tam;
Writeln('Da chen xong, bam <Enter> ... ');
Readln
End;
{-------------------------------------}
Procedure Xoa(Var Nut1 : ConTro; So1 : Integer);
Var
NutTruoc : ConTro;
TimThay : Boolean;
Begin
Tam := Nut1;
NutTruoc := Nil;
TimThay := False;
While (Tam <> Nil) And (Not TimThay) Do
If Tam^.So = So1 Then
TimThay := True
Else
Begin
NutTruoc := Tam;
Tam := Tam^.Next;
End;
If TimThay Then
Begin
If NutTruoc = Nil Then
Nut1 := Tam^.Next
Else
NutTruoc^.Next := Tam^.Next;
Dispose(Tam);
Write(' Da xoa xong, bam <Enter> ... ');
Readln
End
Else
Begin
Write(' Khong tim thay, bam <Enter> ... ');
Readln
End;
End;
{-------------------------------------}
Procedure Xem(Var Nut1 : ConTro);
Begin
Tam := Nut1;
While Tam <> Nil Do
Begin
Write(Tam^.So : 6);
Tam := Tam^.Next;
End;
Writeln;
Write(' Xem xong, bam <Enter> . . .');
Readln
End;
{-------------------------------------}
BEGIN
ClrScr;
Writeln(' NHAP, CHEN, XEM, XOA SO NGUYEN');
Writeln(' ------------------------------');
Writeln;
Nut1 := Nil;
Repeat
New(Tam);
Write('-Nhap so: ');
Readln(Tam^.So);
Tam^.Next := Nut1;
Nut1 := Tam;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch)= 'K';
Repeat
ClrScr;
Repeat
Writeln;
Writeln('CHON CHUC NANG');
Writeln('--------------');
Writeln('1-Chen ');
Writeln('2-Xoa ');
Writeln('3-Xem ');
Writeln('4-Ket thuc ');
Ch := Readkey;
Until Ch in ['1'..'4'];
Case Ch Of
'1' : Begin
Write('-So muon chen: ');
Readln(So1);
Chen(Nut1,So1);
End;
'2' : Begin
Write('-So muon xoa: ');
Readln(So1);
Xoa(Nut1,So1);
End;
'3' : Begin
Xem(Nut1);
End;
End;
Until Ch = '4';
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____++++++++++++____+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Dao_Danh_Sach;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
So : Integer;
Next : ConTro;
End;
VAR
Nut1,Tam1,Tam2 : ConTro;
Ch : Char;
BEGIN
ClrScr;
Writeln(' DAO NGUOC DANH SACH');
Writeln(' -------------------');
Nut1 := Nil;
Repeat
New(Tam1);
Write('-Nhap so: ');
Readln(Tam1^.So);
Tam1^.Next := Nut1;
Nut1 := Tam1;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch)= 'K';
Tam1 := Nut1;
Nut1 := Nil;
Repeat
Tam2 := Tam1^.Next;
Tam1^.Next := Nut1;
Nut1 := Tam1;
Tam1 := Tam2;
Until Tam1 = Nil;
Writeln('Sau khi dao: ');
Tam1 := Nut1;
While Tam1 <> Nil Do
Begin
Write(Tam1^.So:6);
Tam1 := Tam1^.Next;
End;
Writeln;
Write(' Bam <Enter> . . . ');
Readln
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_+++_+_+_+_+__++_+__+_+_+_+_)))
(---------------------------------The End--------------------------------------)
Program Ghep_Chuoi;
Uses Crt;
TYPE
ConTro = ^Nut;
Nut = RECORD
Kt : Char;
Next : ConTro;
End;
VAR
Dau1,Cuoi1 : ConTro;
Dau2,Cuoi2 : ConTro;
Tam : ConTro;
Ch : Char;
i : Integer;
BEGIN
ClrScr;
Writeln('CHUOI THU NHAT');
Writeln('--------------');
Writeln;
i := 0;
Repeat
i := i + 1;
New(Tam);
Write('-Ky tu thu: ',i:2,' : ');
Readln(Tam^.Kt);
If i = 1 Then
Begin
Dau1 := Tam;
Cuoi1 := Tam;
End
Else
Begin
Cuoi1^.Next := Tam;
Cuoi1 := Tam;
End;
Write('Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch) = 'K';
ClrScr;
Writeln('CHUOI THU HAI');
Writeln('--------------');
Writeln;
i := 0;
Repeat
i := i + 1;
New(Tam);
Write('-Ky tu thu: ',i:2,' : ');
Readln(Tam^.Kt);
If i = 1 Then
Begin
Dau2 := Tam;
Cuoi2 := Tam;
End
Else
Begin
Cuoi2^.Next := Tam;
Cuoi2 := Tam;
End;
Write('Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch) = 'K';
Cuoi1^.Next := Dau2;
Cuoi2^.Next :=Nil;
Writeln;
Writeln(' KET QUA');
Writeln('---------');
Tam := Dau1;
While Tam <> Nil Do
Begin
Write(Tam^.Kt);
Tam := Tam^.Next;
End;
Writeln;
Write(' Bam <Enter> . . . ');
Readln
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____++++++++++++____+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End-------------------------------------)
Program Mang_Con_Tro_Hai_Chieu;
Uses Crt;
TYPE
ConTro = ^BanGhi;
BanGhi = RECORD
HoTen : String[24];
Pre, Next : ConTro;
End;
VAR
First,Last,P : ConTro;
i : Byte;
Heaptop : Pointer;
{----------------------------------}
Procedure KhoiTao;
Begin
First := Nil;
Mark(HeapTop);
i := 0;
Repeat
Inc(i);
New(P);
Write('-(Khong nhap,bam <Enter>). Ho ten nguoi thu: ',i:2,' : ');
Readln(P^.HoTen);
If First = Nil Then
Begin
First := P;
First^.Pre := Nil
End
Else
Begin
Last^.Next := P;
P^.Pre := Last;
End;
Last := P;
Last^.Next := Nil
Until P^.HoTen ='';
End;
{----------------------------------}
Procedure DuyetXuong;
Var
P : ConTro;
i : Byte;
Begin
P := First;
i := 0;
While P <> Nil Do
Begin
Inc(i);
Writeln(i:2,'>... : ',P^.HoTen: -28);
P := P^.Next;
End;
End;
{----------------------------------}
Procedure DuyetLen;
Var
P : ConTro;
i : Byte;
Begin
P := Last;
i := 0;
While P <> Nil Do
Begin
Inc(i);
Writeln(i:2,'>... : ',P^.HoTen: -28);
P := P^.Pre;
End;
End;
{----------------------------------}
BEGIN
ClrScr;
Writeln('DUYET DANH SACH THEO 2 CHIEU');
Writeln('Tu dau den cuoi danh sach');
Writeln('Tu cuoi len dau danh sach');
Writeln('-------------------------');
Writeln;
KhoiTao;
Writeln;
Writeln(' Bam <Enter> de xem tu tren xuong duoi danh sach');
Readln;
ClrScr;
DuyetXuong;
Writeln;
Writeln(' Bam <Enter> de xem tu duoi len tren danh sach');
Readln;
DuyetLen;
Writeln;
Write(' Bam <Enter> de ket thuc ');
Readln;
Release(HeapTop);
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+______+_+_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Danh_Sach_Lien_ket;
Uses Crt;
TYPE
ConTro = ^BanGhi;
BanGhi = RECORD
HoTen : String[24];
DiaChi : String[20];
ChucVu : String[15];
DonVi : String[20];
Next : ConTro;
End;
VAR
First, Last,P,F: ConTro;
Ch : Char;
{-------------------------------------}
Procedure Noi;
{-------------------------------------}
Procedure Nhap;
Begin
With P^ Do
Begin
Write('-Ho va ten: ');
Readln(HoTen);
Write('-Dia chi : ');
Readln(DiaChi);
Write('-Chuc vu : ');
Readln(Chucvu);
Write('-Don vi : ');
Readln(DonVi);
End;
End;
{-------------------------------------}
Begin
ClrScr;
If First = Nil Then
Begin
New(P);
Nhap;
First := P;
P^.Next := Nil;
First := P;
Last := P;
End
Else
Begin
F := P;
New(P);
Nhap;
F^.Next := P;
P^.Next := Nil;
End;
End;
{-------------------------------------}
Procedure Duyet;
Var
P : ConTro;
Begin
P := First;
While P <> Nil Do
Begin
With P^ Do
Writeln(HoTen,' , ',DiaChi,' , ',ChucVu,' , ',DonVi);
P := P^.Next;
End;
Writeln;
Writeln('Bam <Enter> ... ');
Readln
End;
{-------------------------------------}
BEGIN
First := Nil;
Repeat
ClrScr;
Repeat
Write('Bam (N)oi, (D)uyet, hoac (K)et thuc ');
Ch := ReadKey;
If Ch = #0 Then
Ch := Readkey;
Writeln;
Ch := UpCase(Ch);
Until Ch In ['N','D','K'];
If Ch = 'N' Then
Noi
Else
If Ch = 'D' Then
Duyet
Until Ch = 'K'
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+____+__++_+__+_+_+_+_)))))
(---------------------------------The End-------------------------------------)
Program Danh_Sach_Moc_Noi;
Uses Crt;
TYPE
ConTro = ^SoNguyen;
SoNguyen = RECORD
So : Integer;
Next : ConTro;
End;
VAR
First,Last,P :ConTro;
So1 : Integer;
Ch : Char;
{----------------------------------}
Procedure Nhap(Var First, Last : ConTRo);
Var
i : Integer;
Begin
ClrScr;
Writeln('NHAP DU LIEU');
Writeln('------------');
Writeln;
i := 0;
Repeat
i := i + 1;
New(P);
Write('-So thu: ',i:2,' = ');
Readln(P^.So);
If i = 1 Then
Begin
First := P;
Last := P;
End
Else
Begin
Last^.Next := P;
Last := P;
End;
Write(' Nhap nua khong ? (c/k) ');
Readln(Ch);
Until UpCase(Ch) = 'K';
Last^.Next := Nil
End;
{----------------------------------}
Procedure Noi(Var First,Lasr : ConTro; Var So1 : Integer);
Begin
Writeln;
New(P);
P^.So := So1;
If First = Nil Then
First := P;
Last^.Next := P;
Last := P;
Last^.Next := Nil;
Writeln;
Write('Da noi vao cuoi danh sach, bam <Enter> . . . ');
Readln
End;
{----------------------------------}
Procedure Xoa(Var First : ConTro; Var So1 : Integer);
Begin
Writeln;
So1 :=First^.So;
P := First;
First := First^.Next;
Dispose(P);
Writeln;
Write(' Da xoa so dau, bam <Enter> . . . ');
Readln
End;
{----------------------------------}
Procedure LietKe(First : ConTro);
Begin
Writeln;
P := First;
If P = Nil Then
Writeln('Danh sach rong');
While P <> Nil Do
Begin
Write(P^.So : 5);
P := P^.Next;
End;
Writeln;
Write(' Xem xong, bam <Enter> . . . ');
Readln
End;
{----------------------------------}
BEGIN
First := Nil;
Last := Nil;
Repeat
ClrScr;
Writeln(' DANH SACH MOC NOI');
Writeln(' Them vao cuoi, xoa dau danh sach');
Repeat
Writeln('1-Nhap so');
Writeln('2-Liet ke');
Writeln('3-Noi them');
Writeln('4-Xoa');
Writeln('5-Ket thuc');
Writeln;
Write('Chon chuc nang nao: ');
Ch := Readkey;
Until Ch in ['1'..'5'];
Case Ch Of
'1' : Nhap(First, Last);
'2' : LietKe(First);
'3' : Begin
Writeln;
Write('-Nhap so muon noi them: ');
Readln(So1);
Writeln;
Writeln('DANH SACH TRUOC KHI NOI LA');
LietKe(First);
Noi(First,Last,So1);
Writeln;
Writeln('DANH SACH SAU KHI NOI THEM SO LA');
LietKe(First);
End;
'4' : If First = Nil Then
Begin
Writeln(' Danh sach rong, khong xoa duoc');
Writeln('Bam <Enter> . . . ');
Readln
End
Else
Begin
Writeln;
Writeln(' DANH SACH TRUOC KHI XOA SO');
LietKe(First);
Xoa(First,So1);
Writeln('-So vua xoa la: ',So1);
Writeln;
Writeln(' DANH SACH CON LAI SAU KHI XOA SO DAU');
LietKe(First);
End;
End;
Until Ch ='5'
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++___+_+_+_+_+__++_+__+_+_+_+_)))))
(---------------------------------The End------------------------------------)
Program Danh_Sach_LK;
Uses Crt;
TYPE
Str = String[24];
ConTro = ^BanGhi;
BanGhi = RECORD
HoTen : Str;
Luong : Real;
Next : ConTro;
End;
VAR
First : ConTro;
Nv : BanGhi;
Ketthuc : Boolean;
Ch : Char;
{--------------------------------}
Procedure Chen(Var First : ConTro; Nv : BanGhi);
Var
P : ConTro;
Begin
New(P);
P^.HoTen := NV.HoTen;
P^.Luong := NV.Luong;
P^.Next := First;
First := P;
End;
{--------------------------------}
Procedure Xoa(Var First : ConTro; Nv : BanGhi);
Var
P,P1 : ConTro;
Begin
If First^.HoTen = NV.HoTen Then
Begin
P := First;
First :=First^.Next;
Dispose(P);
End
Else
Begin
P := First;
While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
Begin
P1 := P;
P := P^.Next;
End;
If P = Nil Then
Writeln('Khong tim thay')
Else
Begin
P1^.Next := P^.Next;
Dispose(P);
End;
End;
End;
{--------------------------------}
Procedure Tim(First : ConTro; Nv : BanGhi);
Var
P : ConTro;
Begin
P := First;
While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
P := P^.Next;
If P = Nil Then
Writeln('Khong tim thay')
Else
Begin
Writeln('Tim thay');
Writeln(P^.HoTen,' ', P^.Luong:8:1);
End;
End;
{--------------------------------}
Procedure LietKe(First : ConTro);
Var
P : ConTro;
Begin
Writeln;
If First = Nil Then
Writeln('Danh sach rong')
Else
Begin
P := First;
While ( P <> Nil) Do
Begin
Writeln(P^.HoTen,' ',P^.Luong:8:1);
P := P^.Next;
End;
End;
Writeln;
Write('Xem xong, bam <Enter> . . . ');
Readln
End;
{--------------------------------}
Procedure XoaHet(Var First : ConTro);
Var
P1,P : ConTro;
Begin
P := First;
While P <> Nil Do
Begin
P1 := P^.Next;
Dispose(P);
P := P1;
End;
First := Nil
End;
{--------------------------------}
Procedure DaoNguoc(Var First : ConTro);
Var
P,P1,Tam: ConTro;
Begin
If (First <> Nil) And ( First^.Next <> Nil) Then
Begin
P1 := First;
P := P1^.Next;
First^.Next := Nil;
While (P <> Nil) Do
Begin
Tam := P^.Next;
P^.Next := P1;
P1 := P;
P := Tam;
End;
First := P1;
End;
Writeln;
Write('Da dao nguoc danh sach, bam <Enter> . . . ');
Readln
End;
{--------------------------------}
BEGIN
Repeat
ClrScr;
Writeln;
Writeln('CAC CHUC NANG');
Writeln('-------------');
Writeln('Chu y: Danh sach LIFO hoac FILO');
Writeln('Ban ghi nhap vao dau nhung xuat ra cuoi');
Writeln('1-KHOI TAO DANH SACH');
Writeln('2-NOI THEM VAO DANH SACH');
Writeln('3-XOA KHOI DANH SACH');
Writeln('4-TIM KIEM TRONG DANH SACH');
Writeln('5-LIET KE DANH SACH');
Writeln('6-DAO NGUOC DANH SACH');
Writeln('7-KET THUC CHUONG TRINH');
Writeln;
Write('Chon cac chuc nang tu 1 den 7: ');
Readln(Ch);
Case Ch Of
'1' : Begin
Writeln('1-TAO DANH SACH');
First := Nil;
KetThuc := False;
Repeat
With Nv Do
Begin
Write('-Ho ten hoac <Ente> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Begin
Write('-Bac luong : ');
Readln(Luong);
Chen(First,Nv);
End
Else
KetThuc := True;
End;
Until ketThuc;
End;
'2' : Begin
Writeln('2-NOI THEM VAO DAU DANH SACH');
KetThuc := False;
Repeat
With Nv Do
Begin
Write('-Ho ten hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Begin
Write('-Bac luong : ');
Readln(Luong);
Chen(First,Nv);
End
Else
KetThuc := True;
End;
Until ketThuc;
End;
'3' : Begin
Writeln('3.XOA KHOI DANH SACH');
KetThuc := False;
Repeat
With Nv Do
Begin
Write('Ho ten can xoa, hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Xoa(First,NV)
Else
KetThuc := True;
End;
Until KetThuc;
End;
'4' : Begin
Writeln('4-TIM KIEM TRONG DANH SACH');
KetThuc := False;
Repeat
With Nv Do
Begin
Write('Ho ten can tim, hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Tim(First,NV)
Else
KetThuc := True;
End;
Until KetThuc;
End;
'5' : Begin
Writeln('5-LIET KE NOI DUNG DANH SACH');
LietKe(First)
End;
'6' : Begin
Writeln('6-DAO NGUOC NOI DUNG DANH SACH');
DaoNguoc(First)
End;
'7' : Begin
Writeln('7-XOA HET NOI DUNG DANH SACH ROI KET THUC');
XoaHet(First)
End;
End;
Until Ch = '7'
END.
(((((_+_+_+_+_+__+__+_+_+_+_+_____+++++++++++++++_++_+__+_+__++_+__+_+_+_+_)))))
(---------------------------------The End--------------------------------------)
Program Cay_Nhi_Phan;
Uses Crt;
TYPE
Str = String[24];
ConTro = ^BanGhi;
BanGhi = RECORD
HoTen : Str;
Luong : Real;
Trai,Phai : ConTro;
End;
VAR
Goc : ConTro;
Nv : BanGhi;
Ketthuc : Boolean;
Ch : Char;
{--------------------------------}
Procedure Chen(Var Goc : ConTro; Nv : BanGhi);
Var
P,P1 : ConTro;
Begin
If goc = Nil Then
Begin
New(Goc);
With Goc^ Do
Begin
HoTen := NV.HoTen;
Luong := NV.Luong;
Trai := Nil;
Phai := Nil;
End;
End
Else
Begin
P := Goc;
P1 := Nil;
While P <> Nil Do
Begin
P1 := P;
If Nv.HoTen <= P^.HoTen Then
P := P^.Trai
Else
P := P^.Phai;
End;
New(P);
With P^ Do
Begin
HoTen := NV.HoTen;
Luong := NV.Luong;
Trai := Nil;
Phai := Nil;
End;
If NV.HoTen <=P1^.HoTen Then
P1^.Trai := P
Else
P1^.Phai := P;
End;
End;
{--------------------------------}
Procedure Xoa(Var Goc : ConTro; Nv : BanGhi);
Var
P,P1,Q,Q1 : ConTro;
Nhanh :(NhanhTrai,NhanhPhai);
Begin
If Goc = Nil Then
Writeln('Cay rong')
Else
Begin
P := Goc;
P1 := Nil;
While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
Begin
P1 := P;
If Nv.HoTen < P^.HoTen Then
Begin
P := P^.Trai;
Nhanh := NhanhTrai;
End
Else
Begin
P := P^.Phai;
Nhanh := NhanhPhai;
End;
End;
If P = Nil Then
Writeln('Khong tim thay')
Else
Begin
If (P^.Trai = Nil) Then
Q := P^.Phai
Else
Begin
Q := P^.Trai;
Q1 := Nil;
While Q^.Phai <> Nil Do
Begin
Q1 := Q;
Q := Q^.Phai;
End;
If Q1 <> Nil Then
Begin
Q1^.Phai := Q^.Trai;
Q^.Trai := P^.Trai;
End;
If P1 = Nil Then
Goc := Q
Else
Begin
If Nhanh = NhanhTrai Then
P1^.Trai := Q
Else
P1^.Phai := Q;
End;
Dispose(P);
End;
End;
End;
End;
{--------------------------------}
Procedure Tim(Goc : ConTro; Nv : BanGhi);
Var
P : ConTro;
Begin
P := Goc;
While (P <> Nil) And (P^.HoTen <> Nv.HoTen) Do
If NV.HoTen < P^.HoTen Then
P := P^.Trai
Else
P := P^.Phai;
If P = Nil Then
Writeln('Khong tim thay')
Else
Begin
Writeln('Tim thay');
Writeln(P^.HoTen,' ', P^.Luong:8:1);
End;
End;
{--------------------------------}
Procedure LNRLietKe(Goc : ConTro);
Begin
If Goc = Nil Then
Begin
Writeln('Cay rong, chua co du lieu');
End
Else
Begin
If Goc^.Trai <> Nil Then
LNRLietKe(Goc^.Trai);
Writeln(Goc^.HoTen,', ',Goc^.Luong:8:1);
If Goc^.Phai <> Nil Then
LNRLietKe(Goc^.Phai);
End;
End;
{--------------------------------}
BEGIN
Repeat
ClrScr;
Writeln;
Writeln('CAC CHUC NANG CAY NHI PHAN');
Writeln('--------------------------');
Writeln;
Writeln('1-Khoi tao cay');
Writeln('2-Noi them vao cay');
Writeln('3-Xoa khoi cay');
Writeln('4-Tim kiem tren cay');
Writeln('5-Liet ke danh sach');
Writeln('6-Ket thuc chuong trinh');
Writeln;
Write('Chon cac chuc nang tu 1 den 6: ');
Readln(Ch);
Case Ch Of
'1' : Begin
ClrScr;
Writeln('1-KHOI TAO CAY');
Writeln('Cay co thu tu LNR');
Writeln('-----------------');
Writeln;
Goc := Nil;
KetThuc := False;
Repeat
With Nv Do
Begin
Write('-Ho ten hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Begin
Write('-Bac luong : ');
Readln(Luong);
Chen(Goc,Nv);
End
Else
KetThuc := True;
End;
Until ketThuc;
End;
'2' : Begin
ClrScr;
Writeln;
Writeln('2-NOI VAO CAY THEO THU TU');
Writeln('-------------------------');
Writeln;
KetThuc := False;
Repeat
With Nv Do
Begin
Write('-Ho ten hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Begin
Write('-Bac luong : ');
Readln(Luong);
Chen(Goc,Nv);
End
Else
KetThuc := True;
End;
Until ketThuc;
End;
'3' : Begin
ClrScr;
Writeln;
Writeln('3.XOA KHOI CAY');
Writeln('--------------');
Writeln;
KetThuc := False;
Repeat
With Nv Do
Begin
Write('Ho ten can xoa, hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Xoa(Goc,NV)
Else
KetThuc := True;
End;
Until KetThuc;
End;
'4' : Begin
ClrScr;
Writeln('4-TIM KIEM TREN CAY');
Writeln('-------------------');
Writeln;
ketThuc := False;
Repeat
With Nv Do
Begin
Write('Ho ten can tim, hoac <Enter> de ngung: ');
Readln(HoTen);
If HoTen <> '' Then
Tim(Goc,NV)
Else
KetThuc := True;
End;
Until KetThuc;
End;
'5' : Begin
ClrScr;
Writeln('5-LIET KE NOI DUNG CAY');
Writeln('Hien thi theo thu tu ABC...');
Writeln('---------------------------');
Writeln;
LNRLietKe(Goc);
Writeln;
Write('Xem xong bam <Enter> . . . ');
Readln
End;
'6' : Begin
Writeln('7- KET THUC CHUONG TRINH');
Writeln;
End;
End;
Until Ch = '6'
END.
(---------------------------------The End--------------------------------------)
thank các b?n ð? xem bài vi?t c?a m?nh! c?ng ði?m nhAAAAAAAAAAA
(---------------------------------The End--------------------------------------)