bai tap nang cao phan 3

Program KT_ngay;
CONST
Ngay = [1..31];
Thang = [1..12];
Th31ngay: Set of byte = [1,3,5,7,8,10,12];
BaoLoi : Array[1..3] Of String[30] =('-Ban nhap sai ngay, thang',
'-Thang nay khong co ngay 31','-thang 2 khong co ngay nay');
TYPE
NgayThang = RECORD
Ng, Th : Byte;
Nam : Word;
End;
VAR
Nhatky : NgayThang;
Loi : Array[1..3] Of Boolean;
i : Byte;
Nhuan : Boolean;
BEGIN
With Nhatky Do
Begin
Write('-Nhap ngay = ');
Readln(Ng);
Write('-Nhap thang= ');
Readln(Th);
Write('-Nhap nam = ');
Readln(Nam);
Loi[1] := (NOT(Ng In Ngay)) OR (NOT (Th In Thang));
Loi[2] := (Ng = 31) AND (NOT (Th In Th31Ngay));
Nhuan := ((Nam Mod 4) = 0) AND ((Nam Mod 100) <> 0)
OR ((Nam Mod 400) = 0);
Loi[3] := ((Ng > 29) AND (Th = 2)) OR ((Ng = 29)
AND (th = 2) AND (NOT Nhuan));
End;
For i := 1 To 3 Do
If Loi[i] Then
Writeln(BaoLoi[i]);
Readln
END.
Program Van_Toan_Ly;
CONST
Max = 50;
Td1='|------------------------|-----|-----|------|';
Td2=#124 +' HO VA TEN ' + #124 + ' VAN ' + #124+
'TOAN ' + #124 + ' LY |';
TYPE
HocSinh = RECORD
HoTen : String[24];
Van,Toan,Ly : Real;
End;
VAR
Hs : Array[1..Max] Of HocSinh;
i,n : 1..Max;
BEGIN
Writeln('NHAP XUAT DU LIEU KIEU BAN GHI');
Writeln('------------------------------');
Writeln;
Write('-Lop co bao nhieu hoc sinh: ');
Readln(n);
For i := 1 To N Do {Nhap du lieu}
With Hs[i] Do
Begin
Write('-Ho ten hoc sinh thu: ',i:2,' = ');
Readln(HoTen);
Write('-Diem Van : ');
Readln(Van);
Write('-Diem Toan: ');
Readln(Toan);
Write('-Diem Ly : ');
Readln(Ly);
End;
Writeln;
Writeln(' BANG DIEM');
Writeln;
Writeln(Td1);
Writeln(Td2);
Writeln(Td1);
For i := 1 To N Do {Xuat du lieu }
With Hs[i] Do
Writeln(#124,HoTen,#32:24 - Length(HoTen),
#124,Van :5:1,
#124,Toan :5:1,
#124,Ly :5:1,' |');
Writeln(Td1);
Readln
END.
Program Sap_Xep_Tuoi_Giam;
CONST
Max = 50;
Td1 = '|========================|============|';
Td2 = #124+' HO VA TEN '+#124 + ' NAM SINH |';
Td3 = '|------------------------|------------|';
TYPE
HoSo = RECORD
HoTen : String[24];
Ngay : 1..31;
Thang : 1..12;
Nam : 1900..2000;
End;
VAR
Nhanvien :Array[1..Max] Of HoSo;
i,n : 1..Max;
Tam : HoSo;
Kthuc: Boolean;
BEGIN
Writeln('SAP XEP BAN GHI THEO GIAI THUAT NOI BOT');
Writeln('---------------------------------------');
Writeln;
Write('-Co bao nhieu nguoi: ');
Readln(n);
For i := 1 to N Do { Nhap du lieu }
With Nhanvien[i] Do
Begin
Write('-Ho va ten nguoi thu: ',i:2,' = ');
Readln(HoTen);
Write('-Ngay sinh: ');
Readln(Ngay);
Write('-Thang : ');
Readln(Thang);
Write('-Nam : ');
Readln(Nam);
End;
Repeat { Sap xep ban ghi}
KThuc := True;
For i := 1 To N - 1 Do
If (Nhanvien[i].Nam > Nhanvien[i+1].Nam)
OR ((Nhanvien[i].Nam = Nhanvien[i+1].Nam) AND
(Nhanvien[i].Thang > Nhanvien[i+1].Thang))
OR ((Nhanvien[i].Nam = Nhanvien[i+1].Nam) AND
(Nhanvien[i].Thang = Nhanvien[i+1].Thang) AND
(Nhanvien[i].Ngay > Nhanvien[i+1].Ngay)) Then
Begin
Tam:=Nhanvien[i];
Nhanvien[i] := Nhanvien[i+1];
Nhanvien[i+1] := Tam;
KThuc :=False;
End;
Until KThuc;
Writeln;
Writeln(' SAP XEP THEO TUOI');
Writeln;
Writeln(Td1);
Writeln(Td2);
Writeln(Td3);
For i := 1 to N Do
With Nhanvien[i] Do
Writeln(#124, HoTen, #32 :24 - Length(HoTen),
#124,Ngay,' / ',Thang,' / ',nam, #124);
Writeln(Td1);
Readln
END.

Program Trac_Nghiem;
TYPE
Tracnghiem = RECORD
CauHoi : String;
A,B,C,D : String;
DapAn : Char;
End;
VAR
a:Array[1..5] Of Tracnghiem;
i,dung : Integer;
Traloi : Char;
BEGIN
Writeln('CAU HOI TRAC NGHIEM');
Writeln('-------------------');
Writeln;
Writeln('-Nhap 5 cau hoi,y nghia va dap an');
For i := 1 To 5 Do
With a[i] Do
Begin
Write('-Cau hoi thu: ',i:2,' : ');
Readln(CauHoi);
Write(' +Nghia A: ');
Readln(A);
Write(' +Nghia B: ');
Readln(B);
Write(' +Nghia C: ');
Readln(C);
Write(' +Nghia D: ');
Readln(D);
Write('-Dap an: ');
Readln(DapAn);
DapAn := UpCase(DapAn);
End;
Dung := 0;
Writeln('-Ban chon nghia cho tung cau hoi');
For i := 1 To 5 Do
Begin
Writeln(i,'. ',a[i].CauHoi);
Writeln(' A)',a[i].A);
Writeln(' B)',a[i].B);
Writeln(' C)',a[i].C);
Writeln(' D)',a[i].D);
Write('-Lua cau nao go vao nghia cua cau do: ');
Readln(TraLoi);
If UpCase(TraLoi) = a[i].DapAn Then
Dung := Dung + 1;
End;
Writeln;
Writeln('-So cau tra loi dung: ',Dung);
Readln
END.
Program Tu_dien;
TYPE
Tudien = RECORD
Anh,Viet : String;
End;
VAR
a: Array[1..5] Of TuDien;
St : String;
i : Integer;
TimDuoc : Boolean;
BEGIN
For i := 1 To 5 Do
Begin
Writeln('-Tu thu: ',i);
Write(' +Nghia tieng Anh : ');
Readln(a[i].Anh);
Write(' +Nghia tieng Viet : ');
Readln(a[i].Viet);
End;
Writeln;
Write('*Tu tieng Anh can tim: ');
Readln(St);
TimDuoc :=False;
i := 1;
While (NOT TimDuoc) AND (i <= 5) Do
Begin
If St = a[i].Anh Then
Begin
Write('*Nghia tieng Viet : ',a[i].Viet);
TimDuoc := True;
End;
i := i + 1;
End;
If NOT TimDuoc then
Writeln('Tu nay khong co trong tu dien');
Readln
END.

Program TT_Doi_Bong;
CONST
Max = 23;
TYPE
ThanhTich=RECORD
HoTen:String[24];
Tuoi,BanThang:Integer;
END;
DoiBong = Array[1..Max] Of ThanhTich;
VAR
i,n,TuoiCao,TuoiThap,nam:Integer;
Ten1,Ten2,TenDoi:String[20];
CauThu:DoiBong;
ThangNhieu,ThangIt:Integer;
Tb:Real;
BEGIN
Writeln('THANH TICH CUA DOI BONG DA');
Writeln('--------------------------');
Write('-Thanh tich nam nao: ');
Readln(Nam);
Write('-Ten doi bong: ');
Readln(TenDoi);
Write('-So cau thu: ');
Readln(n);
For i:=1 To n Do
With Cauthu[i] Do
Begin
Write('-Ho va ten cau thu thu: ',i:2,' la: ');
Readln(HoTen);
Write('-Tuoi cua cau thu thu: ',i:2,' la: ');
Readln(Tuoi);
Write('-So ban thang cua cau thu thu: ',i:2,' la: ');
Readln(BanThang);
End;
TuoiCao:=CauThu[1].Tuoi;
Tuoithap:=CauThu[1].Tuoi;
ThangNhieu:=Cauthu[1].Banthang;
ThangIt:=CauThu[1].BanThang;
Ten1:=CauThu[1].HoTen;
Ten2:=CauThu[1].HoTen;
Tb:=CauThu[1].BanThang;
For i:=2 To n Do
Begin
If CauThu[i].Tuoi > TuoiCao Then
TuoiCao:=CauThu[i].Tuoi
Else
If CauThu[i].Tuoi < TuoiThap Then
Tuoithap :=CauThu[i].Tuoi;
If CauThu[i].BanThang > ThangNhieu Then
Begin
ThangNhieu:=Cauthu[i].BanThang;
Ten1:=CauThu[i].HoTen;
End
Else
If CauThu[i].BanThang < ThangIt Then
Begin
ThangIt:= CauThu[i].BanThang;
Ten2:=CauThu[i].HoTen;
End;
Tb:=Tb+CauThu[i].BanThang;
End;
Writeln;
Writeln('THANH TICH NAM: ',nam);
Writeln('Cua doi bong: ',TenDoi);
Writeln('-----------------------');
Writeln;
Writeln('-Cau thu: ',Ten1,' co tuoi lon nhat: ',TuoiCao);
Writeln('-Cau thu: ',Ten2,' co tuoi nho nhat: ',TuoiThap);
Writeln;
Writeln('-Cau thu: ',Ten1,' Co ban thang nhieu nhat: ',ThangNhieu);
Writeln('-Cau thu: ',Ten2,' Co ban thang it nhat: ',ThangIt);
Writeln;
Writeln('-So ban thang trung binh cua toan doi: ',Round(Tb/n));
Readln
END.

Program So_Huu_Ty;
TYPE
HuuTy = RECORD
TuSo, MauSo : Integer;
End;
VAR
So1, So2, Kq : HuuTy;
St1, St2 : String;
i,Result, n, m : Integer;
Ch : Char;
BEGIN
Writeln('NHAP, XUAT SO HUU TY');
Writeln('--------------------');
Writeln;
Write('-So thu nhat: ');
Readln(St1);
Write('-So thu hai : ');
Readln(St2);
i := Pos('/', St1);
With so1 Do
If i = 0 Then
Begin
Val(St1, TuSo, Result);
MauSo := 1;
End
Else
Begin
Val(Copy(St1, 1, i-1), TuSo, Result);
Val(Copy(St1, i+1, Length(St1)-i), MauSo, Result);
End;
i := Pos('/', St2);
With So2 Do
If i = 0 Then
Begin
Val(St2, TuSo, Result);
MauSo := 1;
End
Else
Begin
Val(Copy(St2, 1, i-1), TuSo, Result);
Val(Copy(St2, i+1, Length(St2)-i), MauSo, Result);
End;
Write('Chon phep tinh (+, -, *, /): ');
Readln(Ch);
Case Ch Of
'+' : Begin
Kq.TuSo := So1.TuSo*So2.MauSo + So1.MauSo * So2.TuSo;
Kq.MauSo := So1.MauSo * So2.MauSo;
End;
'-' : Begin
Kq.TuSo := So1.TuSo*So2.MauSo - So1.MauSo * So2.TuSo;
Kq.MauSo := So1.MauSo * So2.MauSo;
End;
'*' : Begin
Kq.TuSo := So1.TuSo*So2.TuSo;
Kq.MauSo := So1.MauSo * So2.MauSo;
End;
'/' : Begin
Kq.TuSo := So1.TuSo*So2.MauSo;
Kq.MauSo := So1.MauSo * So2.TuSo;
End;
End;
If Kq.TuSo = 0 Then
Write('Ket qua : 0')
Else
With Kq Do
Begin
n := ABS(TuSo);
m := ABS(MauSo);
While n <> m Do
If n > m Then
n := n-m
Else
m := m-n;
TuSo :=TuSo Div n;
MauSo := MauSo Div n;
If MauSo = 1 Then
Write('Ket qua : ',TuSo)
Else
Write('Ket qua : ',TuSo,'/',MauSo);
End;
Readln
END.

Program Sap_Xep_Theo_Ten;
TYPE
HoSo = RECORD
HoLot : String[17];
Ten : String[7];
Diem : Real;
End;
VAR
a : Array[1..50] Of HoSo;
Tam : HoSo;
i,j,PhanTu : Integer;
BEGIN
PhanTu := 0;
With Tam Do
Repeat
Write('-Nhap ho lot ( 0 de ket thu): ');
Readln(HoLot);
If HoLot <> '0' Then
Begin
Write('-Nhap ten : ');
Readln(Ten);
Write('-Nhap diem : ');
Readln(Diem);
PhanTu := PhanTu + 1;
a[PhanTu] := Tam;
End;
Until HoLot = '0';
For i := 1 To PhanTu - 1 Do
For j := PhanTu DownTo i+1 Do
If a[j].Ten[1] < a[j-1].Ten[1] Then
Begin
Tam := a[j];
a[j] := a[j-1];
a[j-1] := Tam;
End;
Writeln;
Writeln('------------------------------------');
Writeln('| HO VA TEN | DIEM |');
Writeln('|--------------------------|-------|');
For i := 1 To PhanTu Do
With a[i] Do
Writeln('|',HoLot:17,' ',Ten:7,' |',Diem:5:1,' |');
Writeln('------------------------------------');
Readln
END.

Program Hoa_Don;
CONST
Max = 100;
TYPE
HoaDon = RECORD
NguoiMua : String[24];
TenHang : String[10];
DonGia : Real;
SoLuong : Integer;
End;
VAR
a : Array[1..Max] Of HoaDon;
DsTenHang : Array[1..Max] Of String[10];
Tam : HoaDon;
Spt, SoTenHang, i, j : Integer;
Tong : Real;
KiemTra : Boolean;
BEGIN
Writeln('HOA DON BAN HANG');
Writeln('----------------');
Writeln;
Spt := 0;
With Tam do
Repeat
Write('-Ten nguoi mua (go 0 de thoat): ');
Readln(NguoiMua);
If NguoiMua <> '0' Then
Begin
Write('-Ten hang: ');
Readln(TenHang);
Write('-Don gia : ');
Readln(DonGia);
Write('-So luong: ');
Readln(SoLuong);
Spt := Spt + 1;
a[Spt] := Tam;
End;
Until NguoiMua = '0';
SoTenHang := 0;
For i := 1 To Spt Do
Begin
KiemTra :=False;
For j := 1 To SoTenHang Do
If DsTenHang[j] = a[i].TenHang Then
KiemTra := True;
If NOT KiemTra Then
Begin
SoTenHang :=SoTenHang + 1;
DsTenHang[SoTenHang] := a[i].TenHang;
End;
End;
Writeln;
For i := 1 To SoTenHang Do
Begin
Tong := 0;
For j := 1 To Spt Do
With a[j] Do
If TenHang = DsTenHang[i] Then
Tong := Tong + (DonGia * Soluong);
Writeln(' +Tong so tien mua: ',DsTenHang[i]:10,' = ',tong:10:2);
End;
Readln
END.

Program The_Tich_Long_Go;
TYPE
CachDo = (DuongKinh, ChuVi);
LongGo = RECORD
Cdai : Real;
Dscdai : Real;
Case Cdo : CachDo Of
DuongKinh : (Dk,Dsdk : Real);
ChuVi : (Cvi, Dscvi : Real);
End;
VAR
MaDo :Char;
Go : LongGo;
Ttich : Real;
{------------------------}
Function TheTich(A: LongGo): Real;
Begin
With A Do
Case Cdo Of
DuongKinh : TheTich := Pi*Sqr(Dk-Dsdk)*(Cdai-Dscdai)/40000;
ChuVi : TheTich := Sqr(Cvi-Dscvi)*(Cdai-Dscdai)/(Pi*40000);
End;
End;
BEGIN
Writeln('TINH THE TICH LONG GO');
Writeln('---------------------');
Writeln;
Repeat
Writeln('*Chon phuong phap do ?');
Write('+Duong kinh (go K), +Chu vi (go V): ');
Readln(Mado);
Until Pos(Mado,'kKvV') <> 0;
With Go Do
Begin
Write('-Chieu dai (m) = ');
Readln(Cdai);
Write('-Dung sai (m) = ');
Readln(Dscdai);
Case Mado Of
'k','K' : Begin
Cdo := DuongKinh;
Write('+Duong kinh (Cm): ');
Readln(Dk);
Write('+Dung sai (Cm) : ');
Readln(Dsdk);
End;
'v','V' : Begin
Cdo := Chuvi;
Write('+Chu vi (Cm) : ');
Readln(Cvi);
Write('+Dung sai (Cm) : ');
Readln(Dscvi);
End;
End;
End;
Ttich :=TheTich(Go);
Writeln;
Writeln('*The tich long go la: ',Ttich:10:4,' m3');
Writeln;
Writeln('Bam phim <Enter> de ket thuc');
Readln
END.