markdown:
| |
| |
![]()
| |
| |![]()
| |![]()
| |
| || |
| |
#
1
| |
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,302,052 ![]()
Đã cảm ơn: 159 bài viết
Được cảm ơn
645 lần trong 184 bài ![]()
![]()
![]()
![]()
![]()
![]()
![]()
| |![]()
Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1
## Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1
1/Sắp Xếp Theo Tên:
Code:
Program Sap_Xep_Theo_Ten; TYPE ConTro = ^HoSo; HoSo = RECORD HoLot : String[17]; Ten : String[7]; Diem : Real; End; VAR a : Array[1..50] Of HoSo; Tam : ConTro; i,j,PhanTu : Integer; BEGIN PhanTu := 0; New(Tam); 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.
2/Sắp xếp điểm tăng:
Code:
Program Sap_Xep_Diem_Tang; TYPE ConTro = ^Lop; Lop = RECORD HoTen : String[24]; NamSinh : Integer; DiemTb : Real; End; VAR Hs : Array[1..50] Of lop; i,j,n : Integer; Tam : ConTro; Begin Writeln('SAP XEP DIEM TANG DAN);'); Writeln('Giai thuat noi Buble'); Writeln('--------------------'); New(Tam); Writeln; Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write('+Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write('+Nam sinh: '); Readln(NamSinh); Write('+Diem trung binh: '); Readln(DiemTb); End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].DiemTb > Hs[j+1].DiemTb Then Begin Tam^ := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam^; End; Writeln; Writeln(' DANH SACH SAP XEP'); Writeln; For i := 1 To N Do With Hs[i] Do Writeln('-',HoTen:24,' :',Namsinh:4,' , ',DiemTb:5:2); Readln End.
3/Hóa Đơn:
Code:
Program Hoa_Don; CONST Max = 100; TYPE ConTro = ^HoaDon; 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 : ConTro; Spt, SoTenHang, i, j : Integer; Tong : Real; KiemTra : Boolean; BEGIN Writeln('HOA DON BAN HANG'); Writeln('----------------'); Writeln; Spt := 0; New(Tam); 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.
4/Thư viện sách:
Code:
Program Thu_Vien; Uses Crt; TYPE ConTro = ^ThuVien; ThuVien = RECORD TenSach : String[30]; TacGia : String[24]; Namxb : Byte; NguoiMuon: String[24]; Next : ConTro; End; VAR First,Last,Newp : ConTro; ds,dm : Integer; Ch : Char; HeapTop : ^Integer; BEGIN ClrScr; GotoXY(5,25); Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat'); Window(1,1,80,24); Writeln('QUAN LY THU VIEN'); Writeln('----------------'); Writeln; ds := 0; dm := 0; First := Nil; Mark(Heaptop); Repeat New(Newp); With Newp^ Do Begin Write('-Ten sach : '); Readln(TenSach); If TenSach <> '' Then Begin ds := ds + 1; Write('-Tac Gia: '); Readln(TacGia); Write('-Nam xuat ban : '); Readln(Namxb); Write('-Nguoi muon (Khong co ai muon thi bam <Enter>: '); Readln(NguoiMuon); If NguoiMuon <> '' Then dm := dm + 1; End; End; If First = Nil Then First := Newp Else Last^.Next := Newp; Last :=Newp; Last^.Next := Nil; Ch := ReadKey; Until Ch = #27; ClrScr; Writeln('QUAN LY THU VIEN'); Writeln('----------------'); While First <> Nil Do With First^ Do Begin Writeln('-Ten sach: ',TenSach); Writeln('-Tac gia : ',TacGia); Writeln('-Nam Xuat ban: ',Namxb); Writeln('-Nguoi muon : ',NguoiMuon); First := Next; End; Writeln; Writeln('+Tong so sach: ',Ds); Writeln('+So sach cho muon: ',Dm); Release(HeapTop); Writeln; Write(' Bam <Esc> de thoat'); Readln END.
5/Hồ Sơ Nhân Viên:
Code:
Program Ho_So_Nhan_Vien; Uses Crt; TYPE ConTro = ^HoSo; HoSo = RECORD HoTen : String[24]; Tuoi : Integer; Luong : LongInt; Next : ConTro; End; VAR First, Last, Newp : ConTro; Hoten1, Hoten2 : String[24]; i,TuoiMax,TuoiMin : Integer; LuongMax, LuongMin,LuongTb : LongInt; Ch : Char; HeapTop :^Integer; Begin ClrScr; Writeln('HO SO NHAN VIEN'); Writeln('---------------'); Writeln; GoToXY(5,25); Write('Bam <Enter> de tiep tuc, bam <Esc> de thoat '); Window(1,2,80,25); First :=Nil; Mark(HeapTop); i := 0; Repeat i := i + 1; New(Newp); With Newp^ Do Begin Write('-Ho ten nhan vien thu: ',i:2,' la= '); Readln(HoTen); Write('-Tuoi = '); Readln(Tuoi); Write('-Bac luong = '); Readln(Luong); TuoiMax := Tuoi; TuoiMin := Tuoi; LuongMax := Luong; LuongMin := Luong; HoTen1 := HoTen; HoTen2 := HoTen; End; If First = Nil Then First := Newp Else Last^.Next := Newp; Last := Newp; Last^.Next := Nil; Ch := ReadKey; Until Ch = #27; Writeln; While First <> Nil Do With First^ Do Begin If Tuoi > TuoiMax Then TuoiMax := Tuoi Else If Tuoi < TuoiMin Then TuoiMin := Tuoi; If Luong > LuongMax Then Begin LuongMax := Luong; HoTen1 := HoTen; End Else If Luong < LuongMin Then Begin LuongMin := Luong; HoTen2 := HoTen; End; First := Next; End; Writeln; Writeln('Nhan vien co tuoi lon nhat la: ',TuoiMax); Writeln('Nhan vien co tuoi nho nhat la:',TuoiMin); Writeln('Nhan vien: ',HoTen1,' ,co bac luong lon nhat: ',LuongMax:10); Writeln('+Nhan vien: ',HoTen2,' ,co bac luong nho nhat: ',LuongMin:10); Release(HeapTop); Writeln; Write(' Bam <Enter> de ket thuc '); Readln End.
6/Tính điểm xếp hạng:
Code:
Program Tinh_Diem_Xep_Hang; TYPE ConTro = ^Lop; Lop = RECORD HoTen : String[24]; NamSinh : Integer; Tb1,Tb2,Tb : Real; End; VAR Hs : Array[1..50] Of lop; i,j,n,Hang: Integer; Tam : ConTro; Begin Writeln('TINH DIEM VA XEP HANG);'); Writeln('Giai thuat noi Buble'); Writeln('--------------------'); Writeln; New(Tam); Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write(' +Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write(' +Nam sinh: '); Readln(NamSinh); Write(' +Diem trung binh hoc ky 1: '); Readln(Tb1); Write(' +Diem trung binh hoc ky 2: '); Readln(Tb2); Tb :=(Tb1 + Tb2)/2; Writeln; End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].Tb < Hs[j+1].Tb Then Begin Tam^ := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam^; End; Writeln; Writeln(' DANH SACH XEP HANG'); Writeln; Hang := 1; For i := 1 To N Do Begin If (i > 1) And (Hs[i].Tb <> Hs[i-1].Tb) Then Hang := i; Writeln(' .Hoc sinh : ',Hs[i].HoTen); Writeln(' .Nam sinh : ',Hs[i].NamSinh); Writeln(' .Diem trung binh ca nam : ',Hs[i].Tb:5:2); Writeln(' .Xep hang ca nam : ',Hang); End; Readln End.
7/Hoán vị chuỗi:
Code:
8/Tách danh sách chẳn lẻ:
Code:
9/Đảo ngược danh sách:
Code:
10/Ghép Chuỗi:
Code:
11/Cây nhị phân (hay):
Code:
12/Đổi thập phân ra nhị phân:
Code:
Program Doi_thap_phan_ra_nhi_phan; Var He10,N,Y:Word; He2,Tam:String; Begin Writeln('DOI SO TU HE THAP PHAN SANG HE NHI PHAN'); Writeln(' -----------------'); Writeln; Write('-Nhap so nguyen he thap phan: '); Readln(He10); N:=He10; He2:=' '; Repeat Y:=He10 Mod 2; Str(Y, Tam); He2:=Tam + He2; He10:= He10 Div 2; Until He10 = 0; Writeln; Writeln('+So he 10 la : ',N); Writeln('+Doi sang he 2 la: ',He2); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End.
13/Mảng kí tự:
Code:
Program Mang_Ky_Tu; Var a:Array[Char] Of Integer; Ch:Char; Begin Writeln('IN MA ASCII CUA CAC KY TU'); Writeln('------------------------'); For Ch:='A' To 'Z' Do Begin a[Ch]:=Ord(Ch); Writeln('-Ky tu: ',Ch,' ma ASCII = ',a[ch]); End; Writeln; Writeln('Bam phim <Enter> de ket thuc'); Readln End.
14/Trung bình cộng:
Code:
Program Tb_cong; Var i,so,dem,tong:Integer; Tb:Real; A:Array[1..100] Of Integer; Begin Writeln('TINH TRUNG BINH CONG CAC SO NGUYEN'); Writeln('----------------------------------'); Writeln; dem:=0; Tong:=0; Write('-Nhap so nguyn: '); Readln(so); While so > 0 Do Begin dem:=dem+1; a[dem]:=so; Write('-Nhap so nguyen (-1 de ngung): '); Readln(so); End; For i:=1 to dem Do Tong:=Tong+A[i]; Tb:=Tong/dem; Writeln; Writeln('+Trung binh cong cua: ',dem:2,' so vua nhap = ',Tb:8:2); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
15/Chèn một số vào hàng:
Code:
Program Chen; Var i,spt:Integer; so,vitri:Integer; a:Array[1..100] Of Integer; Begin Writeln('CHEN MOT SO VAO MANG'); Writeln('--------------------'); Write('-Co bao nhieu phan tu: '); Readln(spt); For i:=1 To spt Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; Writeln; Writeln('MANG TRUOC KHI CHEN'); For i:=1 To spt Do Write(a[i]:6); Writeln; Write('-Can che so: '); Readln(so); Write('-Vao vi tri: '); Readln(vitri); For i:=spt+1 Downto Vitri+1 Do a[i]:=a[i-1]; a[vitri]:=so; spt:=spt+ 1; Writeln; Writeln('MANG SAU KHI CHEN'); For i:=1 To spt Do Write(a[i]:6); Readln End.
16/Xóa phần tử trong mảng:
Code:
Program Xoa_Pt; Var i,spt,vitri:Integer; a:Array[1..100] Of Integer; Begin Writeln('XOA PHAN TU TRONG MANG'); Writeln('----------------------'); Writeln; Write('-Mang co bo nhieu phan tu: '); Readln(spt); For i:=1 To spt Do Begin Write('-Phan tu A[',i:2,']= '); Readln(a[i]); End; Writeln; Writeln(' MANG TRUOC KHI XOA'); Writeln(' -----------------'); Writeln; For i:=1 To spt Do Write(a[i]:6); Writeln; Writeln; Write('-Vi tri muon xoa: '); Readln(vitri); For i:=vitri to spt - 1 Do a[i]:=a[i+1]; spt:=spt - 1; Writeln; Writeln(' MANG SAU KHI XOA'); Writeln(' ----------------'); Writeln; For i:= 1 to spt Do Write(a[i]:6); Writeln; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
17/Thống kê các số lẻ:
Code:
Program So_le; Var a:Array[1..255] Of Integer; i,spt,sole:Byte; Begin Writeln('THONG KE CAC SO LE'); Writeln('------------------'); Write('-Can nhap bao nhieu so: '); Readln(spt); For i:=1 To spt Do Begin Write('-Phan tu A[',i:2,']= '); Readln(a[i]); End; sole:=0; For i:=1 To spt Do If Odd(A[i]) Then Inc(sole); Writeln; Writeln('-Tong so cac so da nhap: ',spt); For i:= 1 To spt Do Write(a[i]:6); Writeln; Writeln('-Tong so cac so le la: ',sole); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
18/Tính giá trị của đa thức bậc N:
Code:
Program Da_thuc; Var a:Array[1..255] Of Real; i,n:Byte; x,p:Real; Begin Writeln('TINH GIA TRI CUA DA THUC BAC N'); Writeln('------------------------------'); Writeln; Write('-Cho biet bac cua da thuc: '); Readln(n); For i:= N Downto 0 Do Begin Write('-Cho biet he so A[',i:2,']= '); Readln(a[i]); End; Writeln; Write('-Cho biet X= '); Readln(x); P:=a[n]; For i:= N Downto 1 Do P:=x * p + a[i-1]; Writeln; Writeln('+Tri cua da thuc P(x)= ',P:0:6); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
19/Đổi số nguyên kiểu Word ra hệ thập lục:
Code:
Program Doi_he_16; Const KyTuHe16:array[0..$F] Of Char ='0123456789ABCDEF'; Var SoWord:Word; SoHex:String[4]; Begin Writeln('DOI SO NGUYEN KIEU WORD RA HE THAP LUC'); Writeln('--------------------------------------'); Writeln; Write('-Nhap so kieu Word: '); Readln(SoWord); SoHex[0]:=#4; SoHex[1]:= KyTuHe16[Hi(SoWord) SHR 4]; SoHex[2]:= KyTuHe16[Hi(SoWord) AND $F]; SoHex[3]:= KyTuHe16[Lo(SoWord) SHR 4]; SoHex[4]:= KyTuHe16[Lo(SoWord) AND $F]; Writeln('+So nguyen kieu Word = ',soWord); Writeln('+Doi ra so he thap luc = $',SoHex); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
20/Đổi số nguyên kiểu Word ra hệ nhị phân:
Code:
Program Doi_he_2; Const KyTuHe2:array[0..1] Of Char ='01'; Var SoWord:Word; SoBinary:String[16]; i:byte; Begin Writeln('DOI SO NGUYEN KIEU WORD RA HE NHI PHAN'); Writeln('--------------------------------------'); Writeln; Write('-Nhap so kieu Word: '); Readln(SoWord); SoBinary[0]:=#16; For i:=15 DownTo 0 Do If (SoWord AND (1 SHL i)) = (1 SHL i) Then SoBinary[16-i]:= KyTuHe2[1] Else SoBinary[16-i]:= KyTuHe2[0]; Writeln('+So nguyen kieu Word = ',soWord); Writeln('+Doi ra so he nhi phan= B ',SoBinary); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
21/Cộng 2 số nguyên:
Code:
Program Cong_so; Uses Crt; Const spt=301; Type mang=Array[1..spt] Of Integer; Var a,b,kq:Mang; k,na,nb,nmax,tam:Integer; Begin ClrScr; Writeln('CONG 2 SO NGUYEN'); Writeln('----------------'); Writeln; Writeln('+SO THU NHAT (-1 de ket thuc) '); na:=0; Repeat na:=na+1; Write('-Chu so thu: ',na,' = '); Readln(a[na]); Until a[na]=-1; na:=na-1; For k:=0 To na-1 Do a[spt-k]:=a[na-k]; For k:=1 to spt-na Do a[k]:=0; ClrScr; Writeln('+SO THU HAI (-1 de ket thuc) '); nb:=0; Repeat nb:=nb+1; Write('-Chu so thu: ',nb,' = '); Readln(b[nb]); Until b[nb]=-1; nb:=nb-1; For k:=0 To nb-1 Do b[spt-k]:=b[nb-k]; For k:=1 to spt-nb Do b[k]:=0; If na>nb Then nmax:=na Else nmax:=nb; tam:=0; For k:=spt Downto spt-nmax Do Begin kq[k]:=(a[k]+b[k]+tam) Mod 10; tam:=(a[k]+b[k]+tam) Div 10; End; ClrScr; Writeln('KET QUA CONG 2 SO NGUYEN'); Writeln('------------------------'); Write('*So thu nhat: '); For k:=spt-na+1 To spt Do Write(a[k],' '); Writeln; Write('*So thu hai : '); For k:=spt-nb+1 To spt Do Write(b[k],' '); Writeln; Write('*Tong = '); For k:=Spt-nmax To spt Do Write(kq[k],' '); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
22/Nhân 2 số nguyên:
Code:
Program Nhan_so; Uses Crt; Const spt=900; Type mang=Array[1..spt] Of Integer; Var a,b,c,kq:Mang; i,j,k,na,nb,tam:Integer; {---------------------------} Procedure Nhap(Var a:mang; Var na:Integer); Var k:Integer; Begin na:=0; Repeat na:=na+1; Write('-Chu so thu: ',na,' = '); Readln(a[na]); Until a[na]=-1; na:=na-1; For k:=0 To na-1 Do a[spt-k]:=a[na-k]; For k:=1 to spt-na Do a[k]:=0; End; {---------------------------} Procedure Cong(a:mang; Var b:mang); Var tam1,tam2,k:Integer; Begin tam1:=0; For k:= spt Downto 1 Do Begin tam2:=(a[k]+b[k]+tam1) Div 10; b[k]:=(a[k]+b[k]+tam1) Mod 10; tam1:=tam2; End; End; {---------------------------} BEGIN ClrScr; Writeln('NHAN 2 SO NGUYEN'); Writeln('----------------'); Writeln; Writeln('+SO THU NHAT (-1 de ket thuc) '); Nhap(a,na); ClrScr; Writeln('+SO THU HAI (-1 de ket thuc) '); Nhap(b,nb); For k:=1 To spt Do kq[k]:=0; For j:=spt Downto spt-nb Do Begin For k:=1 to spt Do c[k]:=0; tam:=0; For i:=spt Downto spt-na Do Begin c[j+i-spt]:=(b[j]*a[i]+tam) Mod 10; tam:=(b[j]*a[i]+tam) Div 10; End; Cong(c,kq) End; ClrScr; Writeln('KET QUA NHAN 2 SO NGUYEN'); Writeln('-----------------------'); Writeln; Write('*So thu nhat: '); For k:=spt-na+1 To spt Do Write(a[k],' '); Writeln; Write('*So thu hai : '); For k:=spt-nb+1 To spt Do Write(b[k],' '); Writeln; Write('*Tich = '); For k:=Spt-(na+nb)+1 To spt Do Write(kq[k],' '); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln END.
23/Ma trận vuông 10x10 phần tử:
Code:
Program Ma_tran_vuong; Uses Crt; Var a:Array[1..10, 1..10] Of Integer; i,j:Integer; Begin Writeln('MA TRAN VUONG 10 x 10 PHAN TU'); Writeln('-----------------------------'); ClrScr; Window(10,5,60,25); For i:= 1 To 10 Do Begin For j:=1 To 10 Do Begin If i=j Then a[i,j]:=i Else a[i,j]:=0; Write(a[i,j]:5); End; Writeln(#10) End; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
24/Tìm một số trong mảng:
Code:
Program Tim_so; Var a:Array[1..4,1..6] Of Integer; i,j,so,solan:Integer; Begin Writeln('TIM MOT SO TRONG MANG'); Writeln('---------------------'); Writeln; For i:=1 To 4 Do For j:=1 to 6 Do Begin Write('-Phan tu A[',i,',',j,']= '); Readln(a[i,j]); End; Writeln; Write('-So muon tim: '); Readln(so); solan:=0; For i:=1 To 4 Do For j:=1 To 6 Do If so=a[i,j] Then Begin solan:=solan+1; Writeln('+Lan: ',solan,' tai hang: ',i,' cot: ',j); End; Writeln; Writeln('+Tong so lan xuat hien la: ',solan); For i:=1 To 4 Do Begin For j:=1 To 6 Do Write(a[i,j]:8); Writeln; End; Readln End.
25/Giải hệ phuơng trình tuyến tính 2 ẩn:
Code:
Program Giai_he_PT_tuyen_tinh; Var A:Array[1..2, 1..2] Of Real; C:Array[1..2] Of Real; x,y,dt,dtx,dty:Real; i,j:Integer; Begin Writeln('GIAI HE PT TUYEN TINH 2 AN'); Writeln('--------------------------'); Writeln; Writeln('-Nhap cac he so A cua he phuong trinh: '); For i:=1 to 2 Do For j:=1 To 2 Do Begin Write('+Phan tu A[',i,',',j,']= '); Readln(a[i,j]); End; Writeln; Writeln('-Nhap cac he so C cua he phuong trinh: '); For i:=1 to 2 Do Begin Write('+Phan tu C[',i,']= '); Readln(c[i]); End; Writeln; {Giai he phuong trinh} Dt:= a[1,1]*a[2,2]-a[1,2]*a[2,1]; {Dt: Dinh thuc} Dtx:=c[1]*a[2,2]-c[2]*a[2,1]; Dty:=a[1,1]*c[2]-a[1,2]*c[1]; If Dt <> 0 Then Begin x:=Dtx / Dt; y:=Dty / Dt; Writeln('X= ',x); Writeln('Y= ',y); End Else Begin If (Dtx=0) And (Dty=0) Then Writeln(#7,#7,#7,' Co vo so nghiem') Else Writeln(#7,#7,#7,'Vo nghiem'); End; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
26/Nhân ma trận:
Code:
Program Nhan_ma_tran; Const Max=10; Type Matran=Array[1..Max,1..Max] Of Integer; Var A,B,C:Matran; hang1,cot1,i,j,m,n,q:Integer; Begin Writeln('NHAN MA TRAN'); Writeln('------------'); Writeln; Writeln('MA TRAN A:'); Write('-So hang = '); Readln(m); Write('-So cot = '); Readln(n); For i:=1 To m Do For j:=1 To n Do Begin Write('+Phan tu A[',i,',',j,' = '); Readln(a[i,j]); End; Cot1:=m; Hang1:=m; Writeln; Writeln('MA TRAN B:'); Write('-So hang = '); Readln(m); Write('-So cot = '); Readln(n); For i:=1 To m Do For j:=1 To n Do Begin Write('+Phan tu B[',i,',',j,' = '); Readln(b[i,j]); End; For i:=1 To Hang1 Do For j:=1 To n Do Begin c[i,j]:=0; For q:=1 To Cot1 Do c[i,j]:= c[i,j] + a[i,q] * b[q,j]; End; For i:=1 to hang1 Do Begin For j:= 1 To n Do Write((c[i,j]):8); Writeln; End; Readln End.
27/Tìm và xóa các kí tự trùng nhau trong chuổi:
Code:
Program Tim_Xoa; Var St,St1:String; Ch:Char; i,l,l1:Byte; Begin Writeln('TIM VA XOA CAC KY TU TRUNG NHAU TRONG CHUOI'); Writeln(' -----------------'); Writeln; Write('-Nhap mot chuoi: '); Readln(St); St1:=St; i:=1; l:=Length(St); While i <= l Do Begin i:=i+1; If St[i]=St[i - 1] Then Begin Writeln('+Ky tu thu: ',i:2,' la: ',St[i],' bi trung lap'); Write('Ban co muon xoa ky tu nay khong (c/k)'); Readln(Ch); If UpCase(Ch)='C' Then Begin Delete(St,i,1); i:= i - 1; End; End; End; l1:=Length(St); Writeln; Writeln('+Chuoi ban dau : ',St1,' co: ',l:2,' ky tu'); Writeln(' Sau khi xoa ky tu trung nhau'); Writeln(' Chuoi con lai: ',St,' gom: ',l1:2,' ky tu'); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End.
28/Tìm chuổi 2 xuất hiện trong chuổi 1:
Code:
Program Tim_chuoi; Var St1,St2:String; i,sl:Integer; Begin Writeln('TIM CHUOI HAI XUAT HIEN TRONG CHUOI MOT'); Writeln(' --------------'); Writeln; Write('-Chuoi thu nhat: '); Readln(St1); Write('-Chuoi thu hai : '); Readln(St2); sl:=0; For i:=1 To Length(St1) Do If St2 = Copy(St1,i,Length(St2)) Then sl:=sl+1; Writeln; Writeln('+Chuoi thu 2 xuat hien: ',sl:2,' lan trong chuoi 1'); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End.
29/Đổi số La mã ra số thập phân:
Code:
Program So_La_Ma; Label l1; Var St:String; tiep:Char; i,So:Integer; Begin Writeln('DOI SO LA MA RA SO THAP PHAN'); Writeln(' ------------'); Writeln; L1:Write('-Nhap so La ma: '); Readln(St); So:=0; i:=Length(St); While i > 0 Do Case St[i] Of 'I':Begin So:=So+1; i:=i-1; End; 'V':If (i > 1) And (St[i-1] = 'I') Then Begin So:=So+4; i:=i-2; End Else Begin So:=So+5; i:=i-1; End; 'X':If (i > 1) And (St[i-1] = 'I') Then Begin So:=So+9; i:=i-2; End Else Begin So:=So+10; i:=i-1; End; 'L':If (i > 1) And (St[i-1] = 'X') Then Begin So:=So+40; i:=i-2; End Else Begin So:=So+50; i:=i-1; End; 'C':If (i > 1) And (St[i-1] = 'X') Then Begin So:=So+90; i:=i-2; End Else Begin So:=So+100; i:=i-1; End; 'D':If (i > 1) And (St[i-1] = 'C') Then Begin So:=So+400; i:=i-2; End Else Begin So:=So+500; i:=i-1; End; 'M':If (i > 1) And (St[i-1] = 'C') Then Begin So:=So+900; i:=i-2; End Else Begin So:=So+1000; i:=i-1; End; End; Writeln('+So La ma : ',St); Writeln('+Doi ra thap phan: ',So); Writeln; Write('-Tiep tuc nua khong (c/k) '); Readln(tiep); If UpCase(tiep)='C' Then Goto l1; End.
30/Kiểm tra số nhập vào:
Code:
Program Kiem_tra_so; Label tt; Var St:String; So:Real; Dung:Integer; tiep:Char; Begin Repeat Writeln('KIEM TRA SO NHAP VAO'); Writeln(' -----------'); tt:Write('-Nhap mot so: '); Readln(St); Val(St,So,Dung); If Dung = 0 Then Writeln(' +Ban da nhap mot so: ',So:8:2) Else Writeln(' +Khong phai so, xin nhap lai:'); Until Dung = 0; Writeln; Write('-Co tiep tuc khong (C/K) '); Readln(Tiep); If UpCase(Tiep)='C' Then Goto tt; End.
31/Chuơng trình mã hóa:
Code:
Program Ma_hoa; Var St:String; k:Integer; i,n:Integer; Begin Writeln('CHUONG TRINH MA HOA'); Writeln(' -----------'); Write('-Nhap chuoi: '); Readln(St); Write('-Nhap ma so k: '); Readln(k); k:=k Mod 26; For i:= 1 To Length(St) Do Begin n:=Ord(St[i]); If (n >=97) And (n<=122) then Begin n:=n+k; If n > 122 Then n:=(n Mod 122) + 96; End; St[i]:=Chr(n); End; Writeln; Writeln('+Sau khi ma hoa: ',St); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End.
32/Ngắt từng từ trong câu:
Code:
Program Ngat_tu; Var St:String; Begin Writeln('NGAT TUNG TU TRONG CAU'); Writeln(' --------------'); Writeln; Write('-Nhap mot cau: '); Readln(St); Repeat While (St[1] =' ') And (Length(St) <> 0) Do Delete(St,1,1); While (St[1] <> ' ') And (Length(St) <>0) Do Begin Write(St[1]); Delete(St,1,1); End; Writeln; Until Length(St)=0; Readln End.
33/Kiểm tra kí tự trùng của 2 chuổi:
Code:
Program Cung_Ky_Tu; Var St1,St2:String; Dung:Boolean; i:Integer; Begin Writeln('KIEM TRA KY TU TRUNG CUA 2 CHUOI'); Writeln(' --------------'); Writeln; Write('-Nhap chuoi 1: '); Readln(St1); Write('-Nhap chuoi 2: '); Readln(St2); Dung:=False; If Length(St1)=Length(St2) Then Begin Dung:=True; For i:= 1 To Length(St1) Do If Pos(St1[i],St2) = 0 Then Dung:=False Else Delete(St2,Pos(St1[i],St2),1); End; If Dung Then Writeln('+Hai chuoi co cung cac ky tu') Else Writeln('+Hai chuoi co cac ky tu khac nhau'); Readln End.
34/Kiểm tra chuổi đối xứng:
Code:
Program Chuoi_Doi_Xung; Var St:String; l,i:Integer; Dung:Boolean; Begin Writeln('KIEM TRA CHUOI DOI XUNG'); Writeln(' -------------'); Writeln; Write('-Nhap chuoi: '); Readln(St); l:=Length(St); Dung:=True; For i:=1 To (l Div 2) Do If St[i] <> St[l-i+1] Then Dung:=False; If Dung Then Writeln('+Chuoi nay doi xung') Else Writeln('+Chuoi nay khong doi xung'); Readln End.
35/Đổi số thập phân ra số la mã:
Code:
Program So_La_Ma; Var So,So1,i:Integer; St:String; Begin Writeln('DOI SO THAP PHAN SANG SO LA MA'); Writeln(' ------------'); Writeln; Write('-Nhap so nguyen: '); Readln(So); So1:=So; St:=' '; For i:=1 To (so Div 1000) Do St:=St+'M'; So:=So Mod 1000; If So >= 900 Then Begin St:=St+'CM'; So:=So-900; End Else If So >=500 Then Begin St:=St+'I'; So:=So-500; End Else If So >=400 Then Begin St:=St+'CD'; So:=So-400; End; For i:=1 To (so Div 100) Do St:=St+'C'; So:=So Mod 100; If So >= 90 Then Begin St:=St+'XC'; So:=So-90; End Else If So >=50 Then Begin St:=St+'L'; So:=So-50; End Else If So >=40 Then Begin St:=St+'XL'; So:=So-40; End; For i:=1 To (so Div 10) Do St:=St+'X'; So:=So Mod 10; If So >= 9 Then Begin St:=St+'IX'; So:=So-9; End Else If So >=5 Then Begin St:=St+'V'; So:=So-5; End Else If So >=4 Then Begin St:=St+'IV'; So:=So-4; End; For i:=1 To So Do St:=St+'I'; Writeln; Writeln('+So thap phan: ',So1); Writeln('+So La ma : ',St); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End.
36/Mãng số thực:
Code:
Program Mang_so_thuc; Const Max = 100; Type Mang=Array[1..Max] Of Real; Var i,n:Integer; A:mang; Begin Writeln('MANG SO THUC'); Writeln('------------'); Repeat Write('-Cho biet so phan tu: '); Readln(N); Until N <= Max; For i:=1 To N Do Begin Write('+Phan tu thu: ',i,' = '); Readln(a[i]); End; Writeln; Writeln('IN THEO THU TU NGUOC'); Writeln('--------------------'); Writeln; For i:=N Downto 1 Do Write(a[i]:4:1,' '); Writeln; Writeln; Writeln('IN CAC DOI SO CUA CAC PHAN TU MANG'); Writeln('----------------------------------'); Writeln; For i:=1 To N Do Write(a[i]:4:1,' '); Writeln; Readln End.
37/Tổng tích ma trận:
Code:
Program Tong_Tich_Ma_tran; Uses Crt; Type Matran=array[1..3,1..3] Of Integer; Var a,b,c,d:Matran; i,j,k:Byte; Ch:Char; {*****************************} Procedure Nhap(Var m:Matran; Ten:Char); Begin ClrScr; GotoXY(26,6); Write('-Nhap ma tran: ',Ten); For i:=1 To 3 Do For j:=1 to 3 Do Begin GotoXY(20*i-8,10+2*j); Write(Ten,'[',i,',',j,']= '); Readln(m[i,j]); End; End; {*****************************} Procedure Xuat(m:Matran; Ten:Char); Begin ClrScr; GotoXY(26,6); Write('CAC PHAN TU CUA MA TRAN: ',Ten); For i:=1 To 3 Do For j:=1 To 3 Do Begin GotoXY(20*i-8,10+2*j); Write(Ten,'[',i,',',']= ',m[i,j]); End; End; {*****************************} BEGIN Nhap(a,'A'); Nhap(b,'B'); For i:=1 To 3 Do For j:=1 To 3 Do c[i,j]:=a[i,j]+b[i,j]; Writeln; Writeln('MA TRAN TONG'); Writeln; Xuat(c,'C'); GotoXY(10,25); Write('Bam phim <Esc> de xem ma tran tich'); For i:=1 to 3 Do For j:=1 To 3 Do Begin d[i,j]:=0; For k:=1 To 3 Do d[i,j]:=a[i,k]*b[k,j]+d[i,j]; End; Repeat Ch:=Readkey; If Ch=#0 then Ch:=Readkey; Until Ch=#27; Writeln('MA TRAN TICH= '); Xuat(d,'D'); Repeat Until KeyPressed; END.
38/Sắp xếp mảng tăng dần:
Code:
Program Mang_tang; Const Max=10; Var a:Array[1..Max] Of Integer; i,j,tam:Integer; Begin Writeln('SAP XEP MANG TANG DAN'); Writeln('---------------------'); Writeln; For i:= 1 To Max Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; For i:=1 to Max-1 Do For j:= i+1 To Max Do Begin If a[i] > a[j] Then Begin tam:=a[i]; a[i]:=a[j]; a[j]:=tam; End; End; Writeln; Writeln('+Mang sau khi sap xep:'); Writeln; For i:=1 To Max Do Write(a[i],' '); Writeln; Readln End.
39/Sắp xếp mảng bảng giải thuật chèn:
Code:
Program Gt_Chen; Const spt=10; Var a:array[1..spt] Of Integer; i,j,k,tam:Integer; Begin Writeln('SAP XEP MANG BANG GIAI THUAT CHEN'); Writeln('---------------------------------'); Writeln; For i:=1 To spt Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; For i:=2 To spt Do If a[i] < a[i-1] Then Begin j:=1; While a[j] < a[i] Do j:=j+1; tam:=a[i]; For k:=i Downto j+1 Do a[k]:=a[k-1]; a[j]:=tam; End; Writeln; Writeln('Mang sau khi sap xep:'); For i:=1 To spt Do Write(a[i]:6); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
40/Sắp xếp mảng bảng giải thuật chọn:
Code:
Program Gt_Chon; Const spt=10; Var a:array[1..spt] Of Integer; min,vitri,i,j:Integer; Begin Writeln('SAP XEP MANG BANG GIAI THUAT CHON'); Writeln('---------------------------------'); Writeln; For i:=1 To spt Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; For i:=1 To spt Do Begin min:=a[spt]; vitri:=spt; For j:=i To spt Do If a[j] < min Then Begin min:=a[j]; vitri:=j; End; a[vitri]:=a[i]; a[i]:=min; End; Writeln; Writeln('Mang sau khi sap xep:'); For i:=1 To spt Do Write(a[i]:6); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
41/Sắp xếp mảng bằng giải thuật nổi bọt:
Code:
Program Gt_Noi_bot; Const spt=10; Var a:array[1..spt] Of Integer; i,j,tam:Integer; Begin Writeln('SAP XEP MANG BANG GIAI THUAT NOI BOT'); Writeln('-----------------------------------'); Writeln; For i:=1 To spt Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; For i:=1 To spt-1 Do For j:= spt Downto i+1 Do If a[j] < a[j-1] Then Begin tam:=a[j]; a[j]:=a[j-1]; a[j-1]:=tam; End; Writeln; Writeln('Mang sau khi sap xep:'); For i:=1 To spt Do Write(a[i]:6); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
42/Giải thuật tìm kiếm tuyến tính:
Code:
Program Tim_Tuyen_Tinh; Const N=10; Var a:array[1..N] Of Integer; so,i:Integer; Begin Writeln('GIAI THUAT TIM KIEM TUYEN TINH'); Writeln('------------------------------'); Writeln; For i:=1 To N Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; Writeln; Write('-So can tim: '); Readln(so); i:=1; While (i <=N) And (a[i] <> so) Do i:=i+1; If i <= N Then Writeln('+Tim thay o vi tri thu: ',i) Else Writeln('+Khong tim thay'); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
43/Giải thuật tìm kiếm nhị phân:
Code:
Program Tim_Nhi_Phan; Const N=10; Var a:array[1..N] Of Integer; so,vt1,vt2,i:Integer; Begin Writeln('GIAI THUAT TIM KIEM NHI PHAN'); Writeln('----------------------------'); Writeln; For i:=1 To N Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; Writeln; Write('-So can tim: '); Readln(so); vt1:=1; vt2:=n; While vt2 >= vt1 Do Begin i:=Trunc((vt1+vt2) Div 2); If so > a[i] Then vt1:=i+1 Else If so < a[i] Then vt2:=i-1 Else vt2:=-1; End; If vt2 = -1 Then Writeln('+Tim thay o vi tri thu: ',i) Else Writeln('+Khong tim thay'); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
44/Xóa bỏ các số trùng nhau:
Code:
Program Bo_so_trung; Const Max=100; Var a:Array[1..Max] Of Integer; i,j,k,n:Integer; Begin Writeln('XOA BO CAC SO TRUNG NHAU'); Writeln('------------------------'); Writeln; Write('-Nhap so phan tu mang: '); Readln(n); For i:=1 To N Do Begin Write('-Phan tu A[',i,']= '); Readln(a[i]); End; i:=2; While i <= N Do Begin j:=1; While a[j] <> a[i] Do j:=j+1; If j < i Then Begin For k:=i to n-1 Do a[k]:= a[k+1]; n:=n-1; End Else i:=i+1; End; Writeln; Write('-Mang con lai: '); For i:=1 to n Do Write(a[i]:8); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
45/Dãy con:
Code:
Program Day_con; Const k=10; a:Array[1..k] Of Integer=(1,3,2,8,10,12,7,29,6,3); Var i:Integer; vt,max:Integer; n,tong:Integer; Begin Vt:=1; max:=a[1]; n:=1; tong:=a[1]; For i:=2 To k Do Begin If (a[i] > a[i-1]) Then tong:=tong+a[i]; If (a[i] < a[i-1]) Or (i=k) Then Begin If tong > max Then Begin max:=tong; vt:=n; End; n:=i; tong:=a[i]; End; End; Writeln('-Day con la: '); i:=vt; Repeat Write(a[i]:6); max:=max-a[i]; i:=i+1; Until max=0; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
46/Chữ hoa:
Code:
Program Chu_hoa; Uses Crt; Const a:Array[1..10] Of String[24]=('nguyen trung truc','dinh tien hoang', 'nguyen cong tru','le thanh ton','le loi','le lai','tran hung dao', 'nguyen hue','chu van an','mac dinh chi'); Var k,j:Byte; {-------------------------} Procedure ChuHoa(x,y:Byte; a:String); Var k:Byte; Begin For k:=1 To length(a) Do If (k=1) Or ((a[k-1]=' ') And (a[k]<>' ')) Then Begin GotoXY(x+k-1,y); Write(UpCase(a[k])); End; End; Begin ClrScr; For k:=1 To 10 Do Begin GotoXY(5,k); Write(a[k]:-24); ChuHoa(5,k,a[k]) End; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
47/Tam giác Pascal:
Code:
Program Tg_Pascal; Const n=10; Var a:Array[1..n, 1..n] Of Integer; i,j:Integer; Begin Writeln('TAM GIAC PASCAL'); Writeln('---------------'); Writeln; For i:=1 To n Do a[i,1]:=1; For j:=1 To n Do a[1,j]:=0; For i:=2 To n Do For j:=2 To n Do a[i,j]:=a[i-1,j-1]+a[i-1,j]; For i:=1 To n Do Begin For j:=1 To i Do Write(a[i,j]:4); Writeln; End; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
48/Phân tích số nguyên duơng nhỏ nhất:
Code:
Program Phan_tich; Const n=15; Var a:Array[1..n, 1..n] Of Longint; i,j,i1,j1:Integer; Begin Writeln('PHAN TICH SO NGUYEN DUONG NHO NHAT'); Writeln('----------------------------------'); Writeln; For i:=1 To n Do For j:=1 To n Do a[i,j]:=i*i*i + j*j*j; Writeln; Writeln('IN KET QUA'); Writeln('----------'); For i:=1 To n Do For j:=1 To i Do Begin For i1:= i+1 To n Do For j1:=1 To j-1 Do If a[i,j]=a[i1,j1] Then Writeln(a[i,j],' = ',i,' ^3 ',' + ',j,' ^3 ',' = ', i1,' ^3 ',' + ',j1,' ^3'); End; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln End.
49/Bảng cửu chuơng:
Code:
Program Cuu_Chuong; Uses Crt; Type cc1=Array[1..5, 1..10] Of Byte; cc2=Array[6..10, 1..10] Of Byte; Var i,j:Byte; Procedure In1; Var a:cc1; cot,hang:Byte; Begin cot:=1; hang:=3; For i:=1 To 5 Do For j:=1 To 10 Do Begin GotoXY(cot,hang); a[i,j]:=i * j; TextColor(Yellow); Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|'); hang:=hang+1; If hang > 12 Then Begin hang:=3; cot:=cot+15; End; End; End; Procedure In2; Var a:cc2; cot,hang:Byte; Begin cot:=1; hang:=14; For i:=6 To 10 Do For j:=1 To 10 Do Begin GotoXY(cot,hang); a[i,j]:=i * j; Textcolor(LightMagenta); Writeln(i:2,' lan ',j:2,' =',a[i,j]:3,'|'); hang:=hang+1; If hang > 23 Then Begin hang:=14; cot:=cot+15; End; End; End; BEGIN ClrScr; Textcolor(Cyan); Writeln(' BANG CUU CHUONG'); Writeln(' ---------------'); In1; Textcolor(LightBlue); Writeln(' -------------------------------------------'); In2; Textcolor(LightGreen); Writeln(' Bam phim <Enter> de ket thuc'); Readln END.
50/Tìm 2 phần tử liên tiếp trong bảng X:
Code:
Program Tim_PT_Mang; Uses Crt; Var a:Array[1..1000] Of Integer; {----------------------------} Procedure Tao; Var k:Integer; Begin Randomize; For k:=1 To 100 Do a[k]:=Random(100); End; {----------------------------} Procedure Tim; Var k,x:Integer; Begin Write('-Nhap gia tri X= '); Readln(x); For k:=1 To 999 Do Begin If a[k] +a[k+1] = X Then Writeln('a[',K,'] + a[',K+1,']= ',X) Else Writeln('Khong co 2 phan tu nao bang: ',X); End; End; BEGIN Writeln('TIM 2 PHAN TU LIEN TIEP BANG GIA TRI X'); Writeln('-------------------------------------'); Writeln; Tao; Tim; Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln; END.
| |
#
2
| |
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,302,052 ![]()
Đã cảm ơn: 159 bài viết
Được cảm ơn
645 lần trong 184 bài ![]()
![]()
![]()
![]()
![]()
![]()
![]()
| |![]()
51/SX Nhị Phân:
Code:
Program SX_Nhi_Phan; Uses Crt; Const Pt=240; Type Mang=Array[1..Pt] Of Integer; Var a:Mang; n:Integer; {---------------------------------} Procedure Sort(Var a: Mang; n:Integer); Var k,j,dau,cuoi,giua,tam:Integer; Begin For k:=2 To n Do Begin tam:=a[k]; cuoi:=1; dau:=k-1; While cuoi <= dau Do Begin giua:=(dau+cuoi) Div 2; If tam < a[giua] Then dau:=giua-1 Else cuoi:=giua+1; End; For j:=k-1 Downto cuoi Do a[j+1]:=a[j]; a[cuoi]:=tam End End; {---------------------------------} BEGIN ClrScr; Randomize; For n:=1 To Pt Do a[n]:=Random(1000); Sort(a,Pt); For n:=1 To Pt Do Write(' ',a[n]:6,' '); Readln END.
52/Kiểm tra ngày tháng:
Code:
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.
53/Điểm Văn Toán Lí:
Code:
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.
54/Sắp xếp tuổi giảm:
Code:
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.
55/Câu hỏi trắc nghiệm:
Code:
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.
56/Từ điển:
Code:
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.
57/Thành tích của đội bóng đá:
Code:
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.
58/Nhập xuất số hữu tỷ:
Code:
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.
59/Sắp xếp theo tên:
Code:
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.
60/Hóa đơn bán hàng:
Code:
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.
61/Tính thể tích lòng gỗ:
Code:
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.
62/Hồ sơ gia cảnh:
Code:
Program Gia_Canh; CONST Max = 100; Td1 ='|========================|========================|======|'; Td2 =#124 +' HO VA TEN '+ #124 +' HO TEN VO CHONG '+ #124 +'SO CON'+#124; Td3 ='|------------------------|------------------------|------|'; TYPE GiaCanh = RECORD HoTen :String[24]; Case GiaDinh : Boolean Of True : (VoChong : String[24]; SoCon : Byte); End; VAR Hsgc :Array[1..Max] Of GiaCanh; n, i : 1..Max; Ch : Char; BEGIN Writeln('HO SO GIA CANH'); Writeln('--------------'); Writeln; Write('-So luong nhan vien: '); Readln(n); For i := 1 To N Do {Nhap du lieu} With Hsgc[i] Do Begin Write('+Ho va ten nhan vien thu: ',i:2,' la= '); Readln(HoTen); Write('+Co gia dinh chua (C/K) '); Readln(Ch); Ch := UpCase(Ch); If Ch = 'C' Then Begin GiaDinh := True; Write(' +Ho ten vo/chong: '); Readln(VoChong); Write(' +So con : '); Readln(SoCon); End Else GiaDinh := False; End; Writeln; Writeln(#32:25,'HOAN CANH GIA DINH NHAN VIEN'); Writeln(#32:12,Td1); Writeln(#32:12,Td2); Writeln(#32:12,Td3); For i := 1 To N Do {Xuat du lieu } With Hsgc[i] Do Begin Write(#32:12); Write(#124,HoTen,#32:24-Length(HoTen)); If GiaDinh Then Begin Write(#124,VoChong,#32:24-Length(VoChong)); Writeln(#124,SoCon:6,#124); End Else Begin Write(#124,#32:24); Writeln(#124,#32:6,#124); End; End; Writeln(#32:12,Td1); Readln END.
63/Hồ sơ nhân viên:
Code:
Program Ho_So; CONST Max = 100; TYPE Str = String[24]; HoSo = RECORD HoTen : Str; Tuoi : Integer; Luong : Real; End; CongTy = Array[1..Max] Of HoSo; VAR Hoten1, Hoten2 : Str; i,n,TuoiMax,TuoiMin : Integer; LuongMax, LuongMin,LuongTb : Real; Nv : CongTy; Begin Writeln('HO SO NHAN VIEN'); Writeln('---------------'); Writeln; Write('-Co bao nhieu nguoi: '); Readln(n); For i := 1 To N Do With Nv[i] Do Begin Write('-Ho ten nhan vien thu: ',i:2,' la= '); Readln(HoTen); Write('-Tuoi = '); Readln(Tuoi); Write('-Bac luong = '); Readln(Luong); End; TuoiMax := Nv[1].Tuoi; TuoiMin := Nv[1].Tuoi; LuongMax := Nv[1].Luong; LuongMin := Nv[1].Luong; HoTen1 := Nv[1].HoTen; HoTen2 := Nv[1].HoTen; LuongTb := Nv[1].Luong; For i := 2 To N Do Begin If Nv[i].Tuoi > TuoiMax Then TuoiMax := Nv[i].Tuoi Else If Nv[i].Tuoi < TuoiMin Then TuoiMin := Nv[i].Tuoi; If Nv[i].Luong > LuongMax Then Begin LuongMax := Nv[i].Luong; HoTen1 := Nv[i].HoTen; End Else If Nv[i].Luong < LuongMin Then Begin LuongMin := Nv[i].Luong; HoTen2 := Nv[i].HoTen; End; LuongTb := LuongTb + Nv[i].Luong; End; Writeln; Writeln('+Nhan vien co tuoi lon nhat la: ',TuoiMax); Writeln('+Nhan vien co tuoi nho nhat la: ',TuoiMin); Writeln('+Nhan vien: ',HoTen1,' co bac luong lon nhat: ',LuongMax:10:2); Writeln('+Nhan vien: ',HoTen2,' co bac luong nho nhat: ',LuongMin:10:2); Writeln('+Bac luong trung binh cua toan Cong Ty : ',LuongTb/n:10:2); Readln End.
64/Quản lí sách của thư viện:
Code:
Program Thu_vien; CONST Max = 100; TYPE ThuVien = RECORD TenSach : String[30]; TacGia : String[24]; NamXb : 1900..1999; NguoiMuon : String[24]; End; VAR Sach : Array[1..Max] Of ThuVien; i, n, x : Integer; Begin Writeln('QUAN LY SACH CUA THU VIEN'); Writeln('-------------------------'); Write('-So luong sach: '); Readln(n); For i := 1 To N Do With Sach[i] Do Begin Write('+Ten sach : '); Readln(TenSach); Write('+Tac gia : '); Readln(TacGia); Write('+Nam Xuat ban : '); Readln(NamXb); Write('+Nguoi muon (Neu khong co ai muon thi bam <Enter>: '); Readln(NguoiMuon); End; Writeln; x := 0; For i := 1 To N Do With Sach[i] Do Begin Writeln('-Ten sach: ',TenSach); Writeln(' +Tac gia : ',TacGia); Writeln(' +Nam xuat ban : ',NamXb); If NguoiMuon <> ' ' Then Begin Writeln(' +Nguoi muon : ',NguoiMuon); x := x + 1; End; End; Writeln; Writeln('+So sach da cho muon: ',x,' quyen'); Readln End.
65/Sắp xếp điểm tăng dần:
Code:
Program Sap_Xep_Diem_Tang; TYPE Lop = RECORD HoTen : String[24]; NamSinh : Integer; DiemTb : Real; End; VAR Hs : Array[1..50] Of lop; i,j,n : Integer; Tam : Lop; Begin Writeln('SAP XEP DIEM TANG DAN);'); Writeln('Giai thuat noi Buble'); Writeln('--------------------'); Writeln; Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write('+Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write('+Nam sinh: '); Readln(NamSinh); Write('+Diem trung binh: '); Readln(DiemTb); End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].DiemTb > Hs[j+1].DiemTb Then Begin Tam := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam; End; Writeln; Writeln(' DANH SACH SAP XEP'); Writeln; For i := 1 To N Do With Hs[i] Do Writeln('-',HoTen:24,' :',Namsinh:4,' , ',DiemTb:5:2); Readln End.
66/Tính điểm và xếp hạng:
Code:
Program Tinh_Diem_Xep_Hang; TYPE Lop = RECORD HoTen : String[24]; NamSinh : Integer; Tb1,Tb2,Tb : Real; End; VAR Hs : Array[1..50] Of lop; i,j,n,Hang: Integer; Tam : Lop; Begin Writeln('TINH DIEM VA XEP HANG);'); Writeln('Giai thuat noi Buble'); Writeln('--------------------'); Writeln; Write('-So hoc sinh: '); Readln(n); For i := 1 To N Do With Hs[i] Do Begin Write(' +Ho ten hoc sinh thu: ',i:2,' la: '); Readln(Hoten); Write(' +Nam sinh: '); Readln(NamSinh); Write(' +Diem trung binh hoc ky 1: '); Readln(Tb1); Write(' +Diem trung binh hoc ky 2: '); Readln(Tb2); Tb :=(Tb1 + Tb2)/2; Writeln; End; For i := 1 To N-1 Do For j := 1 To N-i Do If Hs[j].Tb < Hs[j+1].Tb Then Begin Tam := Hs[j]; Hs[j] := Hs[j+1]; Hs[j+1] := Tam; End; Writeln; Writeln(' DANH SACH XEP HANG'); Writeln; Hang := 1; For i := 1 To N Do Begin If (i > 1) And (Hs[i].Tb <> Hs[i-1].Tb) Then Hang := i; Writeln(' .Hoc sinh : ',Hs[i].HoTen); Writeln(' .Nam sinh : ',Hs[i].NamSinh); Writeln(' .Diem trung binh ca nam : ',Hs[i].Tb:5:2); Writeln(' .Xep hang ca nam : ',Hang); End; Readln End.
67/Khảo sát 2 đường tròn:
Code:
Program Khao_Sat_Hai_Duong_Tron; TYPE DuongTron = RECORD R : Real; x, y : Real; End; VAR Dt1, Dt2 : DuongTron; Kc, Tong, Hieu : Real; BEGIN Writeln('KHAO SAT 2 DUONG TRON'); Writeln('---------------------'); Writeln; Writeln('*Duong tron thu nhat'); Write(' +Ban kinh: '); Readln(Dt1.R); Write(' +Toa do x: '); Readln(Dt1.x); Write(' +Toa do y: '); Readln(Dt1.y); writeln; Writeln('*Duong tron thu hai'); Write(' +Ban kinh: '); Readln(Dt2.R); Write(' +Toa do x: '); Readln(Dt2.x); Write(' +Toa do y: '); Readln(Dt2.y); Kc := Sqrt(Sqr(Dt1.x - Dt2.x) + Sqr(Dt1.y - Dt2.y)); Tong := Dt1.R + Dt2.R; Hieu := ABS(Dt1.R - Dt2.R); If (Kc = 0) AND (Hieu = 0) Then Writeln('-Hai duong tron trung nhau') Else If (Hieu > Kc) Then Writeln('-Hai duong tron long nhau') Else If (Tong = Kc) OR (Hieu = Kc) Then Writeln('-Hai duong tron tiep xuc nhau') Else If (Tong > Kc) AND (Hieu < Kc) Then Writeln('-Hai duong tron cat nhau') Else If (Tong < Kc) Then Writeln('-Hai duong tron o ngoai nhau'); Readln END.
68/Điểm thi:
Code:
Program Diem_Thi; CONST Max = 50; Td1 = '|========================|======|======|======|'; Td2 = '| HO VA TEN | DIEM | TL1 | TL2 |'; Td3 = '|------------------------|------|------|------|'; Td4 = '|---------------------------------------------|'; TYPE DiemThi = RECORD HoTen : String[24]; Diem1 : Real; Case ThiLai1 : Boolean Of True : (Diem2 : Real; Case ThiLai2 : Boolean Of True : (Diem3 : Real)); End; VAR Diem : Array[1..Max] Of DiemThi; n, i : 1..Max; BEGIN Writeln('-So luong sinh vien: '); Readln(n); For i := 1 To N Do With Diem[i] do Begin Write('+Ho va ten sinh vien thu: ',i,' = '); Readln(HoTen); Write('+Diem thi : '); Readln(Diem1); If Diem1 < 5 Then Begin ThiLai1 := True; Write(' -Diem thi lai lan 1= '); Readln(Diem2); If Diem2 < 5 Then Begin ThiLai2 := True; Write(' -Diem thi lai lan 2= '); Readln(Diem3); End; End; End; Writeln(#32:34,'KET QUA HOC TAP'); Writeln(#32:20,Td1); Writeln(#32:20,Td2); Writeln(#32:20,Td3); For i := 1 To N Do With Diem[i] Do Begin Write(#32:20); Write(#124,HoTen,#32:24-length(HoTen)); Write(#124,Diem1:6:1); If Diem1 < 5 Then Begin Write(#124,Diem2:6:1); If Diem2 < 5 Then Writeln(#124,Diem3:6:1,#124) Else Writeln(#124,#32:6,#124); End Else Writeln(#124,#32 :6, #124, #32 :6, #124); End; Writeln(#32:20,Td4); Readln END.
69/Tính đa thức:
Code:
Program Da_Thuc; CONST MaxOrder = 10; TYPE PolyNom = RECORD Bac : Integer; HeSo : Array[0..MaxOrder] Of Real; End; VAR A,B,C : Polynom; i : Integer; {-------------------------} Procedure Nhap; Var i : Integer; Begin Repeat Writeln; Writeln('Hay nhap 2 da thu A(x), B(x) voi'); Write('-Bac A (phai <= ',MaxOrder,' ) = '); Readln(A.Bac); If A.Bac > MaxOrder Then Writeln(#7,'Bac A phai <= ',MaxOrder,' ! nhap lai '); Write('-Bac B (phai <= ',MaxOrder,' ) = '); Readln(B.Bac); If B.Bac > MaxOrder Then Writeln(#7,'Bac B phai <= ',MaxOrder,' ! nhap lai '); Until (A.Bac <= MaxOrder) And (B.Bac <= MaxOrder); For i := 0 To MaxOrder Do Begin A.Heso[i] :=0; B.Heso[i] :=0; End; Writeln; Writeln('Nhap ca he so cua da thuc A: '); For i := A.Bac DownTo 0 Do Begin Write(' A[',i,'] = '); Readln(A.heso[i]); End; Writeln; Writeln('Nhap ca he so cua da thuc B: '); For i := B.Bac DownTo 0 Do Begin Write(' B[',i,'] = '); Readln(B.heso[i]); End; End; {-------------------------} Procedure Cong(A,B : Polynom; Var C : Polynom); Var BacMax :Integer; Begin If A.Bac < B.Bac Then Begin C.Bac :=B.Bac; For i := A.Bac + 1 To B.Bac Do A.Heso[i] := 0 End Else Begin C.Bac := A.Bac; For i := B.Bac + 1 To A.Bac Do B.Heso[i] := 0 End; C.Bac :=A.Bac; For i := C.Bac To MaxOrder Do C.Heso[i] := 0; For i := 0 To C.Bac Do C.Heso[i] := A.Heso[i] + B.Heso[i]; End; {-------------------------} Procedure Nhan(A,B : Polynom; Var C:Polynom); Var i,j : Integer; Begin For i := 0 To MaxOrder Do C.Heso[i] := 0; For i := 0 To A.Bac Do For j := 0 To B.Bac Do C.Heso[i+j] := C.Heso[i+j] + A.Heso[i] * B.Heso[j]; C.Bac :=A.Bac + B.Bac; End; {-------------------------} procedure Chia(P, Q :Polynom); Var i,k,kk : Integer; G : Polynom; Begin If P.Bac < Q.Bac Then For i := P.Bac + 1 To Q.Bac Do P.Heso[i] := 0; If P.Bac > Q.Bac Then For i := Q.Bac + 1 To P.Bac Do Q.Heso[i] := 0; Write('-Hay cho he so trong ket qua phep chia: '); Readln(kk); Writeln('Da thuc ket qua xep theo so mu giam dan. '); Writeln; Write('Bac: '); For k := 0 To kk Do Write(P.Bac-Q.Bac-k:6); Writeln; Write('He so '); For k := 0 To kk Do Begin G.Heso[k] := P.Heso[P.bac] / Q.Heso[Q.Bac]; If Frac(G.Heso[k]) =0 Then Write(G.Heso[k]:6:0) Else Write(G.Heso[k]:6:0); For i:= Q.Bac DownTo 1 Do P.Heso[P.Bac-Q.Bac+i] := P.Heso[P.Bac+i-1] - G.Heso[k]*Q.Heso[i-1]; For i := P.Bac-Q.bac Downto 0 Do P.Heso[i] :=0; End; End; {--------------------------} BEGIN Nhap; Nhan(A,B,C); Writeln; Writeln('Cac he so cua da thuc tich: '); Write('Bac: '); For i := 0 To C.Bac Do Write(i:7); Writeln; Write('He so: '); For i := 0 To C.Bac Do If Frac(C.Heso[i]) = 0 Then Write(C.Heso[i]:7:0) Else Write(C.Heso[i]:7:0); Writeln; Writeln; Chia(A,B); Readln END.
70/Tạo biến động và theo dỏi kích thước bộ nhớ:
Code:
Program Tao_Bien_Dong; TYPE Str10 = String[10]; PStr = ^Str10; VAR Newp : PStr; i : Integer; Begin Writeln('TAO BIEN DONG VA THEO DOI KICH THUOC BO NHO'); Writeln('-------------------------------------------'); Writeln; Writeln('-Bo nho ban dau la: ',MemAvail,' bytes'); Writeln; For i := 1 To 10 Do Begin New(Newp); Writeln(' +Sau khi tao bien thu: ',i:2,' bo nho con lai la: ',MemAvail,' bytes'); End; Writeln; Writeln('-Bo nho bay gio la : ',MemAvail,' bytes'); Writeln; Writeln(' Bam <Enter> de ket thuc'); Readln End.
71/Tạo và xóa các biến động:
Code:
Program Tao_Bien_Dong; TYPE ConTro = ^BanGhi; BanGhi = RECORD HoTen : String[24]; Tuoi : Byte; DiaChi : String[30]; Next : ConTro; End; VAR Newp : ConTro; HeapTop : Pointer; i : Integer; Begin Writeln('TAO VA XOA CAC BIEN DONG'); Writeln('------------------------'); Writeln; Writeln('-Bo nho ban dau la: ',MemAvail,' bytes'); Mark(HeapTop); Writeln('-Kich thuoc cua ban ghi la: ',Sizeof(BanGhi),' bytes'); For i := 1 To 10 Do Begin New(Newp); Writeln(' +Sau khi tao bien thu: ',i:2,' bo nho con lai: ',MemAvail,' Bytes'); End; Writeln; Writeln('-Bo nho bay gio la: ',MemAvail,' bytes'); Writeln; Writeln(' Bam <Enter> de xoa cac bien dong'); Readln; Release(HeapTop); Writeln; Writeln('-Bo nho bay gio lai la: ',MemAvail,' bytes'); Writeln; Writeln(' Bam <Enter> de ket thuc'); Readln End.
72/Tạo biến động tại địa chỉ cho trước:
Code:
Program Tao_Con_Tro; VAR ConTro : ^String; Begin Writeln('TAO BIEN DONG TAI DIA CHI CHO TRUOC'); Writeln('-----------------------------------'); Writeln; ConTro :=Ptr($B800,$0004); ConTro^ := 'Turbo Pascal'; Writeln('-Du lieu cua bien ma con tro dang tro toi la: ',ConTro^); Writeln; Write(' Bam <Enter> de ket thuc'); Readln End.
73/Tính điểm trung bình của lớp:
Code:
Program Tinh_Diem; TYPE ConTro = ^BanGhi; BanGhi = RECORD HoTen : String[24]; Tuoi : Byte; Diem : Real; End; VAR Newp : ConTro; i,n : Integer; d,tong,tb :Real; Begin Writeln('TINH DIEM TRUNG BINH CUA LOP'); Writeln('----------------------------'); Writeln; Tong := 0.0; Write('-Lop co bao nhieu nguoi: '); Readln(n); Writeln; For i := 1 To N Do Begin New(Newp); With Newp^ Do Begin Write(' +Ho ten nguoi thu: ',i:2,' la: '); Readln(HoTen); Write(' +Tuoi : '); Readln(Tuoi); Write(' +Diem : '); Readln(Diem); d := Diem; Tong :=Tong + d; End; Tb := tong / n; End; Writeln('-Diem trung binh cua lop la: ',Tb:5:2); Readln End.
74/Thay câu:
Code:
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.
75/Hoán vị chuổi:
Code:
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.
76/Số ngẫu nhiên:
Code:
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.
77/Mãng biến động:
Code:
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.
78/Tạo danh sách:
Code:
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:8); 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.
79/Chèn số:
Code:
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.
80/Chèn xóa số:
Code:
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.
81/Tạo danh sách chẳn lẻ:
Code:
Program Tach_Danh_Sach_Chan_Le; 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.
82/Xóa giá trị X trong danh sách:
Code:
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.
83/Đếm số phần tử của danh sách:
Code:
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.
84/Tìm địa chỉ nút cuối:
Code:
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.
85/Tính trị trung bình cộng:
Code:
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.
86/Chèn và Xóa:
Code:
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.
87/Đảo ngược danh sách:
Code:
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.
88/Ghép chuỗi:
Code:
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.
89/Mảng con trỏ 2 chiều:
Code:
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.
90/Danh sách liên kết:
Code:
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.
91/Danh sách móc nối:
Code:
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.
92/Danh sách LK:
Code:
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.
93/Cây nhị phân (code 2):
Code:
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.
94/Đổi số thực ra phân số tối giản:
Code:
Program Phan_So_1; Uses PhanSo1; Var x : T_PhanSo1; r : Real; BEGIN Writeln('DOI SO THUC RA OHAN SO TOI GIAN'); Writeln('-------------------------------'); Writeln; Write('-Nhap mot so thuc: '); Readln(r); Writeln; With x Do Begin KhoiDong; Write('+Doi ra dang phan so la= '); Doi(r); Xuat; Writeln; Write('+Phan so toi gian la = '); Toigian; Xuat; End; Readln END.
95/So sánh, cộng 2 số thức dưới dạng phân số:
Code:
Program Phan_So_2; Uses PhanSo2; Var X,Y : T_PhanSo2; so1,so2 : Real; Begin Writeln('SO SANH, CONG 2 SO THUC DUOI DANG PHAN SO'); Writeln('----------------------------------------'); Writeln; Write('-Nhap so thu nhat: '); Readln(so1); Write('-Nhap so thu hai : '); Readln(so2); X.KhoiDong; Y.KhoiDong; X.Doi(So1); Y.Doi(So2); Writeln; Write('-Doi so thu nhat ra phan so la : '); X.Xuat; Writeln; Write('-Doi so thu hai ra phan so la : '); Y.Xuat; Writeln; Writeln; If X.LonHon(Y) Then Writeln('-So thu nhat lon hon so thu hai'); If Y.LonHon(X) Then Writeln('-So thu hai lon hon so thu nhat'); Writeln; X.Cong(Y); Write('-Tong 2 phan so la : '); X.Xuat; Writeln; Write(' Bam <Enter> . . . '); Readln End.
96/So sánh, cộng 2 số thực chênh lệnh lớn:
Code:
Program Phan_So_3; Uses PhanSo3; Var X,Y : T_PhanSo3; so1,so2 : Real; Begin Writeln('SO SANH, CONG 2 SO THUC CHENH LECH LON'); Writeln('--------------------------------------'); Writeln; Write('-Nhap so thu nhat: '); Readln(so1); Write('-Nhap so thu hai : '); Readln(so2); X.KhoiDong; Y.KhoiDong; X.Doi(So1); Y.Doi(So2); Writeln; If X.LonHon(Y) Then Writeln('-So thu nhat lon hon so thu hai'); If Y.LonHon(X) Then Writeln('-So thu hai lon hon so thu nhat'); Writeln; X.Cong(Y); Write('-Tong 2 so la : '); X.Xuat; Writeln; Write(' Bam <Enter> . . . '); Readln End.
97/Đọc 1 tập tin:
Code:
Program ListDemo; Uses ListUtil; TYPE StrObjPtr = ^StrObj; StrObj = OBJECT(Item) St : ^String; Constructor Init(InitStr : String); Destructor Done; Virtual; Procedure Print; Virtual; End; VAR ItemList : List; F : Text; {bien kieu tap tin van ban} Line : String[80]; {-----------------------------} Constructor StrObj.Init; Begin Item.Init; GetMem(St,length(InitStr) + 1); St^ := InitStr; End; {-----------------------------} Destructor Strobj.Done; Begin FreeMem(St, Length(St^) + 1); Item.Done; End; {-----------------------------} Procedure StrObj.Print; Begin Item.Print; Write(St^); End; {-----------------------------} BEGIN ItemList.Init; Writeln('-Bo nho truoc khi doc tap tin: ',MemAvail,' bytes'); Writeln; Write('-Bam <Enter> de doc tap tin BAITHO.TXT tu dia '); Readln; Assign(F,'BAITHO.TXT'); {Gan bien tap tin} Reset(F); {Mo tap tin da co tren dia } While Not EOF(F) Do Begin Readln(F,Line); ItemList.InsertItem(New(StrObjPtr,Init(Line))) End; Writeln; ItemList.PrintList; Writeln; Writeln; Writeln('-Bo nho sau khi doc tap tin: ',MemAvail,' bytes'); ItemList.DisposeList; Writeln; Writeln; Writeln('-Bo nho sau khi xoa bang Dispose: ',MemAvail,' bytes'); Writeln; Write(' Bam <Enter>. . . '); Readln END.
98/Đọc bộ nhớ dữ liệu:
Code:
Program ListDemo; Uses ListUtil; TYPE IntObjPtr = ^IntObj; IntObj = OBJECT(Item) I : Integer; Constructor Init(InitI : Integer); Procedure Print; Virtual; End; RealObjPtr = ^RealObj; RealObj = OBJECT(Item) R : Real; Constructor init(InitReal : Real); Procedure Print; Virtual; End; StrObjPtr = ^StrObj; StrObj = OBJECT(Item) St : ^String; Constructor Init(InitStr : String); Destructor Done; Virtual; Procedure Print; Virtual; End; VAR ItemList : List; {--------------------------------} Constructor IntObj.Init; Begin Item.Init; I :=InitI; End; {--------------------------------} Procedure IntObj.Print; Begin Item.print; Write(' +So nguyen = ',i); End; {--------------------------------} Constructor RealObj.Init; Begin Item.Init; R := InitReal End; {--------------------------------} Procedure RealObj.Print; Begin Item.Print; Write(' +So thuc = ',r); End; {--------------------------------} Constructor StrObj.Init; Begin Item.Init; Getmem(St,Length(InitStr) +1); St^ := InitStr; End; {--------------------------------} Destructor StrObj.Done; Begin FreeMem(St,Length(St^) + 1); Item.Done; End; {--------------------------------} Procedure StrObj.print; Begin Item.Print; Write(' +Chuoi ky tu = ',St^); End; {--------------------------------} BEGIN ItemList.Init; Writeln('-Bo nho truoc khi chen du lieu: ',MemAvail,' bytes'); ItemList.InsertItem(New(IntObjPtr,Init(123))); ItemList.InsertItem(New(RealObjPtr,Init(123.456))); ItemList.InsertItem(New(StrObjPtr,Init('Turbo Pascal 7.0'))); Itemlist.PrintList; Writeln; Writeln; Writeln('-Bo nho sau khi chen du lieu: ',MemAvail,' bytes'); ItemList.DisposeList; Writeln; Writeln; Writeln('-Bo nho sau khi xoa bang Dispose = ',MemAvail,' bytes'); Writeln; Write(' Bam <Enter> ... '); Readln END.
99/Vẽ hình:
Code:
Program Ve_hinh; Uses Crt,Graph,Dos,Vehinh; TYPE Arc = OBJECT(Circle) StartAngle, EndAngle : Integer; Constructor Init(InitX,InitY,InitRadius, InitS,InitE:Integer); Procedure Show; Virtual; Procedure Hide; Virtual; End; VAR GrDriver, GrMode: Integer; Cung : Arc; C : Circle; P : Point; {-------------------------------------} Constructor Arc.Init; Begin Circle.Init(InitX,InitY,InitRadius); StartAngle := InitS; EndAngle := InitE; End; {-------------------------------------} Procedure Arc.Show; Begin Visible := True; Graph.Arc(X,Y,StartAngle,EndAngle,Radius); End; {-------------------------------------} Procedure Arc.Hide; Var TempColor : Word; Begin TempColor := Graph.GetColor; Graph.SetColor(GetBkColor); Visible := False; Graph.Arc(X,Y,StartAngle,EndAngle,Radius); SetColor(TempColor); End; {-------------------------------------} BEGIN GrDriver := CGA; GrMode := CGAC0; InitGraph(GrDriver,GrMode,'C:\BP\BGI'); C.Init(151,82,50); Cung.Init(151,82,25,0,90); P.Init(151,82); P.Drag(5); Cung.Drag(5); C.Drag(5); CloseGraph END.
100/Phân số (dạng 1):
Code:
UNIT PhanSo1; INTERFACE TYPE T_Dau = -1.. 1; T_PhanSo1 = OBJECT TuSo, MauSo : LongInt; Dau : T_Dau; CONSTRUCTOR KhoiDong; Procedure Doi(r : Real); Procedure ToiGian; Procedure Xuat; End; IMPLEMENTATION CONST Max = 2147483647; R_min = 1E-10; CONSTRUCTOR T_PhanSo1.KhoiDong; Begin End; {--------------------------} Procedure T_PhanSo1.Doi(r : Real); Var PS : T_PhanSo1; Du : Real; Begin If ABS(r) > Max Then RunError(7); If r > 0 Then Dau := 1 Else Dau := -1; r := ABS(r); MauSo := 1; Du := r - Int(r); While Du > R_Min Do Begin r := 10 * r; MauSo := 10 * MauSo; Du := r - Round(r); End; TuSo := Round(r); End; {--------------------------} Procedure T_PhanSo1.ToiGian; Var u : LongInt; Function USCLN(x, y : LongInt) : LongInt; Begin While NOT (x = y) Do If x > y Then x := x - y Else y := y -x; USCLN := x; End; Begin If TuSo = 0 Then Begin MauSo := 1; Dau := 0; Exit; End; u := USCLN(TuSo, MauSo); TuSo := TuSo Div u; MauSo := MauSo Div u; End; {--------------------------} Procedure T_PhanSo1.Xuat; Begin If MauSo = 1 Then Begin If Dau = -1 Then Write('-',TuSo) Else Write(TuSo); Exit End; If Dau = -1 Then Write('-',TuSo, '/', MauSo) Else Write(TuSo,'/',MauSo); End; END.
| |
#
3
| |
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,302,052 ![]()
Đã cảm ơn: 159 bài viết
Được cảm ơn
645 lần trong 184 bài ![]()
![]()
![]()
![]()
![]()
![]()
![]()
| |![]()
|Ðiều Chỉnh |
|Xếp Bài |
| |![]()
Linear Mode
| |
You
may not post new threads
You
may not post replies
You
may not post attachments
You
may not edit your posts Mở Mở Mở
HTML đang
Tắt | |

Pragma: private

Set-Cookie: bblastactivity=0; expires=Sun, 19-Apr-2015 19:34:32 GMT; path=/


markdown:
[Lật xe và Lá thư đặc biệt](http://truyencuoihaynhat.com/dan-gian/4663/)
20/3/ 2014
# Lật xe ngô.
## Một cậu bé vô tình làm đổ cái xe chở ngô.
Người hàng xóm nghe thấy tiếng động liền bảo: “Này, Willis, không sao đâu. Sang đây ăn cơm với bác rồi lát nữa bác lật lại xe cho”.
“Bác thật là tốt”, Willis trả lời. “Nhưng mà cháu sợ bố cháu không thích”.
“Vớ vẩn, sang đây”, người hàng xóm mời chào.
“Thôi được”, cậu bé nhận lời, “nhưng mà thể nào bố cháu cũng ghét”.
Sau bữa cơm thân mật, Willis cảm ơn người hàng xóm tốt bụng và nói: “Cháu cảm thấy thoải mái hơn rất nhiều rồi. Nhưng mà cháu biết bố cháu sẽ bực lắm”.
“Đồ ngốc”, người hàng xóm mỉm cười. “Thế bố cháu đang ở đâu?”.
“Ở trong đống ngô dưới cái xe lật ạ”.
**Lá thư đặc biệt**
*Đứa con nhỏ ngây thơ hỏi bố:*
- Trong trường hợp nào thì người ta gửi thư cho nhau hả bố?
- Đó là khi người ta ở cách xa nhau, muốn trò chuyện tâm sự hoặc có việc phải liên hệ với nhau con ạ.
- Thế sao các cô, các cháu trong xí nghiệp của bố, ngày nào cũng đi làm với bố, mà con thấy cứ thỉnh thoảng lại mang phong bì lại cho bố thế?
- À! Đó là trường hợp đặc biệt.

WARC-Type: response

Content-Type: application/http; msgtype=response

Server: Apache

Vary: Accept-Encoding

Content-Encoding: gzip

Connection: close

Content-Type: text/html; charset=UTF-8


markdown:
-
Phiên bản ttvnol.com mới đã chính thức đi vào hoạt động. Trong quá trình sử dụng, nếu phát hiện các lỗi của phiên bản mới, mời mọi người thông báo
[tại đây](threads/bao-loi-cua-phien-ban-ttvnol-moi-tai-day.853845/).
# Truyện tranh tiếng Anh đê !
Chủ đề trong '
**' bởi Truyện tranh (ACC)** **,**
Chủ đề trong '
**' bởi Truyện tranh (ACC)**

Server: nginx

Cache-control: private, max-age=0

X-Frame-Options: SAMEORIGIN