quanlysach
Program Quanlysach;
{
Chuong trinh quan ly sach nhom VII
Huong dan thuc hien: Co Do Thi Mo;
Cac thanh vien:
Bui Van Menh
Bui Xuan Duong
Phan Huu Dang
Doan Anh Hung
Luong Van Xanh
}
Uses Crt,Mbv_Menu,MediaMbv;
Type
pt=^sach;
ma=String[4];
Sach=record
Masach:ma;
Tensach:String[40];
Namxb:Integer;
Tacgia:String[25];
Sotrang:Word;
Gia:Longint;
Ngaynhap:record
ngay:1..31;
thang:1..12;
nam:Integer;
End;
next:pt;
End;
Var
lcc,lc1,lc2,vt:byte;
dk1,dk2,dk3,dk4:Char;
j:Word;
ddtt:String;
s:sach;
ptm,pttk:Word;
fm,ftk,p,q,r:pt;
ts:array[1..10] of Byte;
dk:array[1..10] of Char;
tb:array[1..10] of String[10];
ms:ma;
td:menu;
{------------------------ Tim theo ma sach ----------------------------------}
FUNCTION Timms(first:pt;masach:ma):pt;
Var
p:pt;
Begin
p:=first;
While (p<>nil) and (p^.masach<>masach) do
p:=p^.next;
Timms:=p;
End;
{------------------------ Luu vao tap tin -----------------------------------}
PROCEDURE Luu(first:pt;t:String);
Var
f:file of sach;
p:pt;
s:sach;
Begin
Assign(f,t);
Rewrite(f);
p:=first;
While p<>nil do
Begin
s:=p^;
Write(f,s);
p:=p^.next;
End;
Hthongbao('','Ghi hoan tat');
End;
{---------------------Dao trat tu cua danh sach------------------------------}
PROCEDURE Dao(var first:pt);
Var
p,q,r:Pt;
Begin
p:=first;
first:=nil;
While p<>nil do
Begin
q:=p^.next;
p^.next:=first;
first:=p;
p:=q;
End;
End;
{----------------------------------------------------------------------------}
PROCEDURE Inx(first:pt;d,spt:Word);Forward;
{----------------------Doc danh sach tu tep----------------------------------}
PROCEDURE Doc(Var first:pt;var spt:Word;dd:String);
Var
f:file of sach;
s:sach;
tentep:String[20];
Begin
Assign(f,dd);
Reset(f);
first:=nil;
spt:=0;
While not Eof(f) do
Begin
New(p);
Read(f,s);
p^:=s;
p^.next:=first;
first:=p;
spt:=spt+1;
End;
Hthongbao('','Da doc xong');
End;
{-----------------------Tim phan tu dung truoc con tro p---------------------}
FUNCTION Prvp(first,p:pt):pt;
Var
q:pt;
Begin
q:=first;
While q<>nil do
Begin
If q^.next=p then
Begin
Prvp:=q;
Exit;
End;
q:=q^.next;
End;
Prvp:=nil;
End;
{-----------------------Xoa phan tu co ma sach cho truoc---------------------}
PROCEDURE Xoapt (var first:pt;var spt:Word;masach:ma);
Var
i:Byte;
Begin
p:=Timms(first,masach);
If p<> nil then
Begin
If p=first then
Begin
first:=p^.next;
End
Else
Begin
q:=prvp(first,p);
p:=p^.next;
q^.next:=p;
End;
spt:=spt-1;
Dispose(q);
End;
End;
{------------------------Tim con tro cua phan tu vi tri n--------------------}
FUNCTION Pvt(first:pt;n:Word):pt;
Var
i:Word;
p:pt;
Begin
p:=first;
For i:=1 to n-1 do p:=p^.next;
Pvt:=p;
End;
{------------------------Doi noi dung cua hai con tro------------------------}
PROCEDURE Thay(Var sc:sach;Var sm:sach);
Var
next:pt;tg:sach;
Begin
tg:=sc;
sc:=sm;
sc.next:=tg.next;
next:=sm.next;
sm:=tg;
sm.next:=next;
End;
{----------------------Kiem tra ma sach da co hay chua-----------------------}
FUNCTION Ktms(first:pt;ms:ma):Boolean;
Var p:pt;
Begin
p:=first;
While p<>nil do
Begin
If p^.masach=ms then
Begin
Ktms:=False;
Exit;
End;
p:=p^.next;
End;
Ktms:=True;
End;
{----------------------In tung phan tu---------------------------------------}
Procedure Inpt(p:pt);
Begin
With p^ do
Begin
Write('º',Masach :4,'º ',Cantrai(Tensach,20),'º',Namxb:4,'º ',Cantrai(tacgia,20),'º',Sotrang:5,'º',Gia:8,'º ');
Write(ngaynhap.ngay:2,'-',ngaynhap.thang:2,'-',ngaynhap.nam:4,'º');
If next<>nil then
Write('ÌÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍ͹')
Else Write('ÈÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍͼ');
End;
End;
{-----------------------Xoa hinh tai vi tri ---------------------------------}
PROCEDURE Xoaxy(x,y,n:Byte);
Var i:Byte;
Begin
Gotoxy(x,y);
For i:=1 to n do Write(' ');
End;
{-----------------------In khung nhap----------------------------------------}
FUNCTION Bangd:Byte;
Var y:Byte;
Begin
y:=Wherey;
Bangd:=y;
Textbackground(1);
Textcolor(14);
Gotoxy(15,y+1); Write('ÉÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
Gotoxy(15,y+2); Write('º Ma sach º º');
Gotoxy(15,y+3); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+4); Write('º Ten sach º º');
Gotoxy(15,y+5); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+6); Write('º Nam in º º');
Gotoxy(15,y+7); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+8); Write('º Tac gia º º');
Gotoxy(15,y+9); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+10); Write('º So trang º º');
Gotoxy(15,y+11); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+12); Write('º Gia tien º º');
Gotoxy(15,y+13); Write('ÌÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
Gotoxy(15,y+14); Write('º Ngay nhapº - - º');
Gotoxy(15,y+15); Write('ÈÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
Textattr:=15;
End;
{-------------------In noi dung phan tu--------------------------------------}
PROCEDURE Inbangd(p:pt;s:String);
Begin
If p=nil then
Begin
Hthongbao('','Khong co ma sach thoa man');
Exit;
End;
With p^ do
Begin
Textattr:=15;
Writeln;
Writeln(s);
i:=Bangd;
Textbackground(Blue);
Gotoxy(28,i+2);Writeln(masach);
Gotoxy(28,i+4);Writeln(tensach);
Gotoxy(28,i+6);Writeln(namxb);
Gotoxy(28,i+8);Writeln(tacgia);
Gotoxy(28,i+10);Writeln(sotrang);
Gotoxy(28,i+12);Writeln(gia);
With Ngaynhap do
Begin
Gotoxy(28,i+14);
Writeln(ngay:2,' - ',thang:2,' - ',nam);
End;
End;
Textbackground(0);
End;
{------------------------In dang danh sach-----------------------------------}
PROCEDURE Iny(first:pt;n,spt:Word);
Var
i,vt:Word;
Phim:Char;
Begin
If first=nil then
Begin
Hthongbao('','Danh sach rong');
Exit;
End;
p:=pvt(first,n);
Repeat
Clrscr;
Writeln;
Writeln('Hien tai dang o vi tri ',n,' tren tong so ',spt);
Inbangd(p,'');
Phim:=Readkey;
Case Phim of
PhimTrai,PhimLen:
Begin
If n>1 then
Begin
p:=prvp(first,p);
n:=n-1;
End;
End;
PhimPhai,Phimxuong:
Begin
If n<spt then
Begin
p:=p^.next;
n:=n+1;
End;
End;
PhimTab:
Begin
If spt<10 then n:=1 Else
If n>=spt-10 then n:=spt-10;
Inx(first,n,spt);
Exit;
End;
End;
Until Phim=PhimEnter;
End;
{------------------------Nhap vao mot phan tu--------------------------------}
FUNCTION Nhap(s:String):pt;
Var ms:ma;p:pt;y,i:Byte;Phim:Char;
Begin
Writeln(s);
y:=Bangd;
Textbackground(1);
Gotoxy(28,y+2);Readln(ms);
If ms='' then Nhap:=nil
Else
Begin
New(p);
With p^ do
Begin
masach:=ms;
Gotoxy(28,y+4);Readln(tensach);
Gotoxy(28,y+6);Readln(namxb);
Gotoxy(28,y+8);Readln(tacgia);
Gotoxy(28,y+10);Readln(sotrang);
Gotoxy(28,y+12);Readln(gia);
With ngaynhap do
Begin
Gotoxy(28,y+14);Read(ngay);
Gotoxy(33,y+14);Read(thang);
Gotoxy(38,y+14);Read(nam);
End;
End;
Nhap:=p;
End;
Textbackground(0);
End;
{-----------------------In theo lan luot-------------------------------------}
PROCEDURE Inx(first:pt;d,spt:Word);
Var
p:pt;c,i,j,y:Byte;Phim:char;n,k:Word;f:Text;
Begin
Clrscr;
If first=nil then
Begin
Hthongbao('','Danh sach rong');
Exit;
End;
Write('ÉÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍ»');
Write('º Ma º Ten sach º Namº Tac gia º So º Gia º Ngay nhap º');
Write('ºsachº º In º ºtrangº º º');
Write('ÌÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍ͹');
p:=pvt(first,d);
q:=pvt(first,d);
If spt-d>=10 then n:=10 else n:=spt-d+1;
For j:=1 to n do
If p<>nil then
Begin
Inpt(p);
p:=p^.next;
End;
n:=d+n-1;
Gotoxy(1,1);
Insline;
Writeln(' Hien tai dang duyet cac sach o vi tri ',d,' den ',n,' tren tong so ',spt);
r:=p;
Repeat
Phim:=Readkey;
Case Phim of
PhimLen:
Begin
If d>1 then
Begin
Gotoxy(1,6);
Insline;
insline;
q:=pvt(first,d-1);
If q<>nil then
Begin
Inpt(q);
d:=d-1;
r:=prvp(first,r);
Gotoxy(1,1);
Clreol;
n:=n-1;
Writeln(' Hien tai dang duyet cac sach o vi tri ',d,' den ',n,' tren tong so ',spt);
End;
End;
End;
Phimxuong:
Begin
If n<spt then
Begin
If (r<>nil) then
Begin
Gotoxy(1,6);
Delline;
Delline;
Gotoxy(1,24);
Inpt(r);
r:=r^.next;
n:=n+1;
Gotoxy(1,1);
Insline;
Writeln(' Hien tai dang duyet cac sach o vi tri ',d+1,' den ',n,' tren tong so ',spt);
d:=d+1;
End;
End;
End;
PhimTab:
Begin
Iny(first,d,spt);
Exit;
End;
End;
Until Phim=PhimEnter;
Textbackground(0);
End;
{-------------------------Tao danh sach--------------------------------------}
FUNCTION Taods(first:pt;ptr:pt;var spt:Word):pt;
Begin
Repeat
If ptr=nil then
Begin
Clrscr;
p:=Nhap('Nhap thong tin cho sach: ');
If p=nil then break;
Readln;
End
Else
Begin
New(p);
p^:=ptr^;
End;
If Not Ktms(first,p^.masach) then
Hthongbao('','Ma sach nay da co')
Else
Begin
spt:=spt+1;
p^.next:=first;
first:=p;
End;
Until (p=nil) or (ptr<>nil);
Taods:=first;
End;
{----------------------So sanh hai con tro-----------------------------------}
FUNCTION Sosanh(a,b:sach;trs:Byte;lc:Char):Boolean;
Begin
Case trs of
1:
Begin
If ((a.masach<b.masach) And (lc='<'))
Or ((a.masach>b.masach) And (lc='>'))
Or ((a.masach=b.masach) And (lc='=')) then Sosanh:=True
Else Sosanh:=False;
End;
2:
Begin
If ((a.tensach<b.tensach) And (lc='<'))
Or ((a.tensach>b.tensach) And (lc='>'))
Or ((a.tensach=b.tensach) And (lc='='))
then Sosanh:=True
Else Sosanh:=False;
End;
3:
Begin
If ((a.namxb<b.namxb) And (lc='<'))
Or ((a.namxb>b.namxb) And (lc='>'))
Or ((a.namxb=b.namxb) And (lc='='))
then Sosanh:=True
Else Sosanh:=False;
End;
4:
Begin
If ((a.tacgia<b.tacgia) And (lc='<'))
Or ((a.tacgia>b.tacgia) And (lc='>'))
Or ((a.tacgia=b.tacgia) And (lc='='))
then Sosanh:=True
Else Sosanh:=False;
End;
5:
Begin
If ((a.sotrang<b.sotrang) And (lc='<'))
Or ((a.sotrang>b.sotrang) And (lc='>'))
Or ((a.sotrang=b.sotrang) And (lc='='))
then Sosanh:=True
Else Sosanh:=False;
End;
6:
Begin
If ((a.gia<b.gia) And (lc='<'))
Or ((a.gia>b.gia) And (lc='>'))
Or ((a.gia=b.gia) And (lc='='))
then Sosanh:=True
Else Sosanh:=False;
End;
7:
Begin
If (
(a.ngaynhap.ngay=b.ngaynhap.ngay)
And (a.ngaynhap.thang=b.ngaynhap.thang)
And (a.ngaynhap.nam=b.ngaynhap.nam)
And (lc='=')
)
Or (
(
(a.ngaynhap.nam>b.ngaynhap.nam)
Or (
(a.ngaynhap.nam=b.ngaynhap.nam)
And (a.ngaynhap.thang>b.ngaynhap.thang)
)
Or (
(a.ngaynhap.nam=b.ngaynhap.nam)
And (a.ngaynhap.thang=b.ngaynhap.thang)
And (a.ngaynhap.ngay>b.ngaynhap.ngay)
)
)
And (lc='>')
)
Or (
(
(a.ngaynhap.nam<b.ngaynhap.nam)
Or (
(a.ngaynhap.nam=b.ngaynhap.nam)
And (a.ngaynhap.thang<b.ngaynhap.thang))
Or (
(a.ngaynhap.nam=b.ngaynhap.nam)
And (a.ngaynhap.thang=b.ngaynhap.thang)
And (a.ngaynhap.ngay<b.ngaynhap.ngay)
)
And (lc='<')
)
)
then Sosanh:=True
Else Sosanh:=False;
End;
End;
End;
FUNCTION Sosanhm(sa,sb:Sach;m:Byte):Boolean;
Begin
If m=1 then Sosanhm:=Sosanh(sa,sb,ts[1],'=')
Else Sosanhm:=Sosanh(sa,sb,ts[m],'=') And Sosanhm(sa,sb,m-1);
End;
{----------------------------------------------------------------------------}
FUNCTION Sosanhn(sa,sb:Sach;n:Byte):Boolean;
Begin
If n=1 then Sosanhn:=Sosanh(sa,sb,ts[1],dk[1])
Else Sosanhn:=(Sosanhm(sa,sb,n-1) And Sosanh(sa,sb,ts[n],dk[n])) Or Sosanhn(sa,sb,n-1);;
End;
{----------------------------------------------------------------------------}
PROCEDURE Max_Min(first:pt;lc:Byte;ts:Byte;m:sach);
Var p:pt;
Begin
p:=first;
M:=p^;
While p<>nil do
Begin
p:=p^.next;
Case lc of
0:If Sosanh(M,p^,ts,'<') then M:=p^;
1:If Sosanh(M,p^,ts,'>') then M:=p^;
End;
End;
End;
{----------------------Xoa theo dieu kien------------------------------------}
PROCEDURE Xoatdk(var first:pt;var spt:Word;sb:sach;ts:Byte;lc:Char);
Begin
p:=first;
While p<>nil do
Begin
If Sosanh(p^,sb,ts,lc) then
Begin
If p=first then first:=p^.next
Else
Begin
q:=prvp(first,p);
q^.next:=p^.next;
End;
spt:=spt-1;
End;
p:=p^.next;
End;
End;
{-------------------Tim kiem theo truong-------------------------------------}
PROCEDURE Timkiem(s:sach;ts:Byte;lc:char);
Var
i:Byte;
p:pt;
Begin
pttk:=0;
New(p);
p:=fm;
ftk:=nil;
While p<>nil do
Begin
If Sosanh(p^,s,ts,lc) then ftk:=Taods(ftk,p,pttk);
p:=p^.next;
End;
Inx(ftk,1,pttk);
Readln;
End;
{-----------------------Cap nhat theo ma sach--------------------------------}
PROCEDURE Capnhat(first:pt;ms:String);
Begin
Repeat
Clrscr;
p:=Timms(first,ms);
If p=nil then
Begin
Hthongbao('','Khong co sach nao thoa man ');
Exit;
End;
Textmode(3+256);
Inbangd(p,' Thong tin cu ');
Writeln;
Textbackground(0);
Writeln;
q:=Nhap(' Thong tin moi ');
If q=nil then
Begin
Textmode(Lo(3));
Textbackground(0);
Exit;
End;
Textmode(Lo(3));
Textbackground(0);
If Ktms(fm,q^.masach) or (q^.masach=p^.masach) then
Begin
Thay(q^,p^);
Exit;
End
Else
Begin
Hthongbao('','Ma sach da co xin moi nhap lai');
Readln;
End;
Until False;
End;
{----------------------Cap nhat theo dieu kien-------------------------------}
PROCEDURE Capnhatdk(sb:sach;trs:Byte;lc:Char);
Begin
p:=fm;
While p<>nil do
Begin
If Sosanh(p^,sb,trs,lc) then
Begin
Capnhat(fm,p^.masach);
End;
p:=p^.next;
End;
End;
{-----------------------Bo sung vao vi tri n---------------------------------}
PROCEDURE Bosungvt(first:pt;n:Word);
Var p,q,r,ss:pt;
Begin
Repeat
Clrscr;
If n>ptm then n:=ptm;
p:=Nhap('Nhap thong tin cho sach can bo sung');
If p=nil then Exit;
If Not ktms(first,p^.masach) then
Begin
Hthongbao('','Ma sach nay da co');
Readln;
End
Else
Begin
If n=1 then
Begin
q:=first;
first:=p;
p^.next:=q;
ptm:=ptm+1;
End
Else
Begin
q:=pvt(first,n-1);
r:=q^.next;
q^.next:=p;
p^.next:=r;
ptm:=ptm+1;
End;
End;
Until False;
End;
{------------------------Bo sung truoc/sau ma sach---------------------------}
PROCEDURE Bosung(first:pt;ms:String;tt:Char);
Var p,r:pt;
Begin
p:=Timms(first,ms);
If p=nil then
If Hluachon('Ma vua nhap khong co trong danh sach','Ban co muon nhap lai khong?')=-1 then Exit;
Repeat
Clrscr;
r:=Nhap('Nhap thong tin cho sach can bo sung:');
If r=nil then Exit;
If Not ktms(first,r^.masach) then
Hthongbao('','Ma sach nay da co')
Else
Case tt of
't':
Begin
prvp(first,p)^.next:=r;
r^.next:=p;
ptm:=ptm+1;
End;
's':
Begin
r^.next:=p^.next;
p^.next:=r;
ptm:=ptm+1;
End;
End;
Readln;
Until False;
End;
{--------------------------Cap nhat theo dieu kien---------------------------}
PROCEDURE Capnhattk;
Begin
For i:=1 to pttk do Capnhat(fm,pvt(ftk,i)^.masach);
End;
{---------------------------Xoa theo dieu kien-------------------------------}
PROCEDURE Xoatk;
Begin
For i:=1 to pttk do
For j:=1 to ptm do
Begin
If pvt(ftk,i)^.masach = pvt(fm,j)^.masach then
Xoapt(fm,ptm,pvt(ftk,i)^.masach);
End;
End;
{-------------------------Menu chon truong-----------------------------------}
PROCEDURE Menuts(var ts:Byte;n:Byte;tde:String);
Var lc:Byte;
Begin
td[1]:='1. Theo ma sach';
td[2]:='2. Theo ten sach';
td[3]:='3. Theo nam xuat ban';
td[4]:='4. Theo tac gia ';
td[5]:='5. Theo so trang ';
td[6]:='6. Theo gia';
td[7]:='7. Theo ngay nhap';
td[8]:='8.Quay tro lai';
ts:=Chonmenu(10,2,60,10,15,10,n,td,tde);
End;
{-------------------------Menu chon gia tri----------------------------------}
PROCEDURE Menudk(ts:Byte;Var dk:Char);
Var lc:Byte;
Begin
Case ts of
1..7:
Begin
td[1]:=' 1. Bang gia tri nhap vao';
td[2]:=' 2. Cao hon gia tri nhap vao';
td[3]:=' 3. Thap hon gia tri nhap vao';
td[4]:=' 4. Quay tro lai';
lc:=Chonmenu(10,2,60,6,15,10,4,td,'Nhap vao dieu kien');
Case lc of
1:dk:='=';
2:dk:='>';
3:dk:='<';
End;
End;
End;
End;
{-----------------------Sap xep tang giam------------------------------------}
PROCEDURE Menudktk(trs:Byte;Var dk:Char);
Var lc:Byte;
Begin
Case trs of
1..7:
Begin
td[1]:=' 1. Tang dan';
td[2]:=' 2. Giam dan';
lc:=Chonmenu(10,2,60,4,15,10,2,td,'Sap xep theo thu tu');
Case lc of
1:dk:='>';
2:dk:='<';
End;
End;
End;
End;
{------------------------Nhap thong tin tim kiem-----------------------------}
PROCEDURE Nhaptk(var s:Sach;ts:Byte);
Begin
Clrscr;
With s do
Case ts of
1: Masach :=HtbNhapchuoi('Dieu kien cua ma sach','Ma sach',dk[1]);
2: Tensach:=HtbNhapchuoi('Dieu kien cua ten sach','Ten sach',dk[1]);
3: Namxb :=HtbNhapso('Dieu kien cua nam xuat ban','Nam xuat ban',dk[1]);
4: Tacgia :=HtbNhapchuoi('Dieu kien cua ten tac gia','Tac gia',dk[1]);
5: Sotrang:=HtbNhapso('Dieu kien cua so trang sach','So trang',dk[1]);
6: Gia :=HtbNhapso('Dieu kien cua gia tien','Gia tien',dk[1]);
7:
Begin
Ngaynhap.ngay:=HtbNhapso('Dieu kien cua ngay nhap','Ngay nhap',dk[1]);
Gotoxy(28,10);
Write(' - -');
Gotoxy(Wherex-5,10);
Readln(ngaynhap.thang);
Gotoxy(38,10);
Readln(ngaynhap.nam);
End;
End;
End;
{--------------------------Chuong trinh chinh--------------------------------}
BEGIN
Repeat
Textattr:=15;
Clrscr;
td[1]:=' 1. Tao danh sach ';
td[2]:=' 2. In danh sach ';
td[3]:=' 3. Cap nhat danh sach ';
td[4]:=' 4. Tim kiem ';
td[5]:=' 5. Sap xep ';
td[6]:=' 6. Doc du lieu tu tep ';
td[7]:=' 7. Luu danh sach vao tep ';
td[8]:=' 8. Gioi thieu ';
td[9]:=' 9. Thoat ';
lcc:=Chonmenu(10,2,60,11,15,10,9,td,' Chuong trinh quan ly sach ');
Case lcc of
1:{Tao danh sach}
Begin
ptm:=0;
Clrscr;
If fm<>nil then
Begin
yn:=Hluachon('Ban se ghi de len danh sach hien tai',' Ban co muon tiep tuc khong?');
If yn=1 then
Begin
fm:=Taods(nil,nil,ptm);
Dao(fm);
End;
End
Else
Begin
fm:=Taods(nil,nil,ptm);
Dao(fm);
End;
End;
2:{In danh sach}
Begin
td[1]:='1. Toan bo danh sach ';
td[2]:='2. Danh sach tim kiem gan nhat ';
td[3]:='3. In danh sach dang duyet lan luot ';
td[4]:='4. Quay tro lai ';
lc1:=Chonmenu(10,2,60,6,15,10,4,td,' In danh sach ');
Case lc1 of
1: Inx(fm,1,ptm);
2:Inx(ftk,1,pttk);
3:Iny(fm,1,ptm);
End;
End;
3:{Cap nhat}
Begin
Repeat
td[1]:=' 1. Them thong tin sach';
td[2]:=' 2. Sua doi thong tin sach';
td[3]:=' 3. Xoa thong tin sach ';
td[4]:=' 4. Quay tro lai';
lc1:=Chonmenu(10,2,60,6,15,10,4,td,'Cap nhat thong tin sach');
Case lc1 of
1:{Them sach}
Begin
td[1]:=' 1. Vao truoc ma sach ';
td[2]:=' 2. Vao sau ma sach ';
td[3]:=' 3. Vao vi tri ';
td[4]:=' 4. Quay tro lai';
lc2:=Chonmenu(10,2,60,6,15,10,4,td,'Cap nhat thong tin sach');
Case lc2 of
1:{Them truoc }
Begin
Clrscr;
Write('Bo sung vao truoc ma sach: ');
Readln(ms);
Bosung(fm,ms,'t');
End;
2:{Them sau}
Begin
Clrscr;
Write('Bo sung vao sau ma sach: ');
Readln(ms);
Bosung(fm,ms,'s');
End;
3:{Them tai vi tri}
Begin
Clrscr;
Write('Nhap vao vi tri muon them: ');
Readln(vt);
Bosungvt(fm,vt);
Readln;
End;
End;
End;
2:{Sua}
Begin
td[1]:='1. Theo dieu kien nhap vao';
td[2]:='2. Theo danh sach tim kiem';
td[3]:='3. Quay tro lai';
lc2:=Chonmenu(10,2,60,5,15,10,3,td,'Sua thong tin ');
Case lc2 of
1:{Theo dieu kien}
Begin
Menuts(ts[1],8,'Cap nhat theo dieu kien nhap ');
Menudk(ts[1],dk[1]);
Nhaptk(s,ts[1]);
Capnhatdk(s,ts[1],dk[1]);
End;
2:Capnhattk;
End;
End;
3:{Xoa}
Begin
td[1]:='1. Theo dieu kien nhap vao';
td[2]:='2. Theo danh sach tim kiem';
td[3]:='3. Quay tro lai';
lc2:=Chonmenu(10,2,60,5,15,10,3,td,'Sua thong tin ');
Case lc2 of
1:{Xoa theo dieu kien}
Begin
Menuts(ts[1],8,'Xoa thong tin sach');
Menudk(ts[1],dk[1]);
Nhaptk(s,ts[1]);
Xoatdk(fm,ptm,s,ts[1],dk[1]);
End;
2:{Xoa theo tim kiem}
Begin
Xoatk;
Hthongbao('','Da xoa xong!');
End;
End;
End;
End;
Until lc1=4;
End;
4:{Tim kiem}
Begin
Clrscr;
td[1]:='1. Tren toan bo danh sach';
td[2]:='2. Tren danh sach tim kiem gan nhat';
td[3]:='3. Quay tro lai';
lc1:=Chonmenu(10,2,60,5,15,10,3,td,'Tim kiem ');
Case lc1 of
1:{Tren toan bo danh sach}
Begin
Menuts(ts[1],8,'Tim kiem');
Menudk(ts[1],dk[1]);
Nhaptk(s,ts[1]);
If ts[1]<>8 then
Timkiem(s,ts[1],dk[1]);
End;
2:{Tren danh sach tim kiem}
Begin
If ftk=nil then Hthongbao('Danh sach tim kiem rong','')
Else
Begin
Menuts(ts[1],8,'Loc ra khoi danh sach');
Menudk(ts[1],dk[1]);
Nhaptk(s,ts[1]);
Xoatdk(ftk,pttk,s,ts[1],dk[1]);
Inx(ftk,1,pttk);
End;
End;
End;
End;
5:{Sap xep}
Begin
td[1]:='1. Sap xep theo 1 chi so';
td[2]:='2. Sap xep theo 2 chi so ';
td[3]:='3. Sap xep theo 3 chi so ';
td[4]:='4. Sap xep theo 4 chi so';
td[5]:='5. Sap xep theo 5 chi so';
td[6]:='6. Quay tro lai ';
lc1:=Chonmenu(10,2,60,8,15,10,6,td,' Sap xep ');
If lc1<6 then
Begin
tb[1]:='dau tien';
tb[2]:='thu hai';
tb[3]:='thu ba';
tb[4]:='thu tu';
tb[5]:='thu nam';
For i:=1 to lc1 do
Begin
Menuts(ts[i],8,'Truong sap xep '+tb[i]);
Menudktk(ts[i],dk[i]);
If ts[i]=8 then break;
End;
p:=fm;
While p^.next<>nil do
Begin
q:=p^.next;
r:=p;
While q<>nil do
Begin
If Sosanhn(r^,q^,lc1) then r:=q;
q:=q^.next;
End;
Thay(p^,r^);
p:=p^.next;
End;
End;
End;
6:{Doc}
Begin
ddtt:=Chontaptin('psd');
Doc(fm,ptm,ddtt);
Dao(fm);
End;
7:{Luu}
Begin
td[1]:=' 1. Luu toan bo danh sach';
td[2]:=' 2. Luu danh sach tim kiem';
td[3]:=' 3. Quay tro lai';
lc1:=Chonmenu(10,2,60,5,15,10,3,td,' Luu tap tin ');
Case lc1 of
1:{Luu toan bo danh sach}
Begin
ddtt:=Chonduongdan('');
Luu(fm,ddtt);
End;
2:{Luu danh sach tim kiem }
Begin
ddtt:=Chonduongdan('');
Luu(ftk,ddtt);
End;
End;
End;
8:{Gioi thieu}
Begin
Gioithieu;
End;
9:{Thoat}
Begin
yn:=Hluachon('','Ban co chac chan muon thoat khong ?');
If yn=1 then Halt;
End;
End;
Until False;
END.
Bạn đang đọc truyện trên: AzTruyen.Top