Thông tin tài liệu
Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 4 Program Lam_tron; Var so:Real; le:Integer; (* *) FUNCTION Tron(so:Real;le:Integer):Real; Var i,n:LongInt; Begin For i:=1 To le+1 Do so:=so*10; n:=Trunc(so); If (n Mod 10) >= 5 Then n:=(n Div 10) +1 Else n:=n Div 10; so:=n; For i:=1 To le Do so:=so/10; Tron:=so; End; (* *) BEGIN Writeln('LAM TRON SO THUC'); Writeln(' Su dung ham'); Writeln(' '); Write('-Nhap so: '); Readln(so); Write('-Can bao nhieu so le: '); Readln(le); Writeln; Writeln(' KET QUA'); Writeln('*So nhap vao = ',so:12:10); Writeln('*So lam tron = ',Tron(so,le):12:le); Writeln; Write(' Bam phim <Enter> de ket thuc '); Readln END. Program Loang_mau; Uses Crt; Const St=' Chao mung ban da den voi THPTXuanLoc.CoM '; Var k:Integer; Procedure Mau(nen,chu:Integer); Begin TextBackGround(nen); TextColor(chu); End; BEGIN TextMode(C80); TextBackGround(Black); ClrScr; For k:=2 To 23 Do Begin Mau(k Mod 8,(k+4) Mod 8 + 8); GotoXY(1,k); Write(St) End; Readln END. Program May_tinh_tay; Var so1,so2,kq:Real; toantu,tiep:Char; thuchien:Boolean; Begin Writeln(' MAY TINH TAY'); Writeln('Thuc hien 4 phep tinh so hoc'); Writeln(' '); Repeat Write('-Bam so: '); Readln(so1); Write('-Phep toan(+,-,*,/): '); Readln(toantu); Write('-Bam so: '); Readln(so2); thuchien:=True; Case toantu Of '+' :kq:=so1+so2; '-' :kq:=so1-so2; '*' :kq:=so1*so2; '/' :If so2 <> 0 Then kq:=so1/so2 Else thuchien:=False; Else thuchien:=False; End; If thuchien Then Writeln('+Ket qua = ',kq:6:2) Else Writeln('+Khong lam duoc'); Writeln; Write('-Thuc hien tiep khong ? (C/K) '); Readln(tiep); Until Upcase(tiep) = 'K'; Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. ! Program Nam_nhuan; Var nam:Word; nhuan:boolean; Begin Writeln('NAM NHUAN HAY NAM THUONG'); Writeln(' '); Write('-Nhap vao nam can kiem tra: '); Readln(nam); If nam Mod 100 = 0 Then Nhuan:=(nam Mod 400)=0 Else Nhuan:=(nam Mod 4)=0; Write('Nam: ',nam, ' la: '); If nhuan Then Writeln('nam nhuan') Else Writeln('nam thuong ( khong nhuan)'); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. "#$% Program Thu_trong_tuan; Var thu,ngay,thang:Byte; Nam,luu:Integer; Begin Writeln('NGAY THU MAY TRONG TUAN'); Writeln(' '); Write('-Ngay: '); Readln(ngay); Write('-Thang: '); Readln(thang); Write('-Nam: '); Readln(nam); luu:=nam; nam:=1900 + (nam Mod 1900); If thang < 3 Then Begin thang:=thang + 12; nam:=nam - 1; End; thu:=ABS(ngay+2*thang+3*(thang+1) Div 5+nam+nam Div 4) Mod 7; Case thu Of 0 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Chu Nhat'); End; 1 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln('+La ngay Thu Hai'); End; 2 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Thu Ba'); End; 3 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Thu Tu'); End; 4 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Thu Nam'); End; 5 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Thu Sau'); End; 6 : Begin Writeln('+Ngay:',ngay:3,',thang:',thang:3,',nam:',luu:5); Writeln(' +La ngay Thu Bay'); End; End; Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. &'()* Program thuaso; Var n,i:Integer; Begin Writeln('PHAN TICH N THANH TICH CAC THUA SO NGUYEN TO'); Writeln(' '); Write('-Nhap so N= '); Readln(n); Repeat i:=2; While (n Mod i <> 0) And (i < n ) Do i:=i + 1; Write(i:4); n:=n Div i; Until n=1; Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. +'(*, -.$ 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. /'01234101) Program Phep_chia; Var chia,bichia,luu,thuong,du:Integer; Begin Writeln('PHEP CHIA CHI LA PHEP TRU'); Writeln(' '); Write('-Nhap so bi chia: '); Readln(bichia); Write('-Nhap so chia: '); Readln(chia); luu:=bichia; thuong:=0; While bichia >=chia Do Begin bichia:=bichia-chia; thuong:=thuong+1; End; du:=bichia; Writeln; Writeln('+Neu dem so ',luu,' chia cho so ',chia,' ket qua la: '); Writeln(' *So thuong = ',thuong:6); Writeln(' *So du = ',du:6); Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. 56789 Program Xo_so; Uses Crt; Var quacau,i:Byte; ch:Char; BEGIN ClrScr; TextColor(Red); Writeln(' QUAY XO SO'); TextColor(Magenta); Writeln(' Su dung ham Random'); TextColor(Yellow); Writeln(' '); Writeln; TextColor(Green); Write(' Cho so qua cau de quay: '); Readln(quacau); Writeln; TextColor(Cyan); Write(' Bam phim bat ky de bat dau quay xo so'); Repeat i:= Random(9); Until KeyPressed; Writeln; TextColor(LightBlue); Write(' Bam phim <Enter> de ngung quay'); Readln; ch:=ReadKey; Writeln; TextColor(Yellow); Writeln(' KET QUA TRUNG THUONG LA SO: '); Writeln; TextColor(Red); Write(' '); For i:=1 To quacau Do Write(' ',Random(9):3); Writeln; Writeln; TextColor(Magenta); Write(' Bam phim <Enter> de ket thuc'); Readln END. 9* Program So_nguyen_to; Var n,i:Integer; Begin Writeln('SO VUA NHAP CO PHAI LA SO NGUYEN TO ?'); Writeln(' '); Write('-Nhap mot so : '); Readln(n); While n > 1 Do Begin i:=2; While (n Mod i <> 0) Do i:=i+1; if i=n Then Writeln('-So ',n,' la so nguyen to') Else Writeln('-So ',n,' khong phai la so nguyen to'); Write('-Nhap mot so (so 0 de ngung): '); Readln(n); End; Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. 9:2* 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. 9 Program So_ngay; Uses Crt; TYPE Nam=1900 2000; Thang=1 12; Ngay=1 31; Var Nam1,Nam2:Nam; Thang1,Thang2:Thang; Ngay1,Ngay2:Ngay; n:Real; kq:Boolean; (* *) FUNCTION KTngay(d:Ngay;m:Thang;y:Nam):Boolean; Begin KTngay:=True; Case m Of 4,6,9,11: If d > 30 Then KTngay:=False; 2 : If (d > 29) Or ((d =29) And (y Mod 4 <> 0)) Then KTngay:=True; End; End; (* *) FUNCTION Julian(d:Ngay;m:Thang;y:Nam):Real; {Lich Julieng} Var Tam:Real; Begin Tam:=Int((m-14.0)/12.0); Julian:=d-32075.0+ Int(1461.0*(y+4800.0+Tam)/4.0+ Int(367.0*(m-2.0-Tam*12.0)/12.0)- Int(3.0*Int(y+4900.00+Tam)/100.0)/4.0) End; (* *) BEGIN {$R+} Repeat ClrScr; Writeln(' *Nhap moc thoi gian dau'); Write('-Ngay: '); Readln(Ngay1); Write('-Thang: '); Readln(Thang1); Write('-Nam: '); Readln(Nam1); Kq:=KTngay(Ngay1,Thang1,Nam1); If not Kq Then Begin Sound(100); Delay(50); NoSound; Writeln('-Ngay khong hop le'); End; Until Kq; Repeat ClrScr; Writeln(' *Nhap moc thoi gian cuoi'); Write('-Ngay: '); Readln(Ngay2); Write('-Thang: '); Readln(Thang2); Write('-Nam: '); Readln(Nam2); Kq:=KTngay(Ngay2,Thang2,Nam2); If not Kq Then Begin Sound(100); Delay(50); NoSound; Writeln('-Ngay khong hop le'); End; Until Kq; n:=Julian(Ngay2,Thang2,Nam2)-Julian(Ngay1,Thang1,Nam1); Writeln('Ket qua: ',n:8:0,' ngay'); Writeln; Writeln(' Bam phim <Enter> de ket thuc '); Readln END. ;7<=2* Program Ngay_cua_thang; Var thang,nam,luu,songay:Integer; Begin Writeln('THANG. X . CO BAO NHIEU NGAY'); Writeln(' '); Write('-Ban muon hoi thang nao co bao nhieu ngay: '); Readln(thang); Write('-Cho biet nam : '); Readln(nam); luu:=nam; Case thang Of 1,3,5,7,8,10,12: songay:=31; 4,6,9,11 : songay:=30; 2 :Case nam Mod 4 Of 1,2,3 :songay:=28; 0 :songay:=29; End; End; If songay >=30 Then Writeln('+Thang:',thang:3,', nam: ',luu:4,', co: ',songay:3,' ngay') Else Writeln('+Thang:',thang:3,', nam: ',luu:5,', co: ',songay:3,' ngay'); Writeln; Writeln(' Bam phin <Enter> de ket thuc'); Readln End. ;>:2*?@( Program So_ngau_nhien; CONST N=100; TYPE Nguyen= Set of 1 N; Var a:Nguyen; So,i,spt:Integer; Begin Writeln('TIM 10 S0 NGUYEN NGAU NHIEN KHONG AM'); Writeln(' NHO HON 100, KHONG TRUNG NHAU'); Writeln(' '); spt:=0; a:=[]; Randomize; Repeat So:=Random(100); If Not (So In a) Then Begin a:=a+[So]; Spt:=Spt +1; End; Until Spt = 10; Writeln; Writeln('10 so ngau nhien nho hon 100 la: '); Writeln; For i:= 0 To 100 Do If i In a Then Write(i,', '); Writeln; Writeln; Write(' Bam phim <Enter> de ket thuc '); Readln End. ";>1%A42*2B1=C2D7 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. &;>*)EB Program Tim_so_nguyen_to; Var n,i,j:Integer; nguyento:Boolean; Begin Writeln('TIM CAC SO NGUYEN TO TU 2 DEN N'); Writeln(' '); Write('-Nhap so N= '); Readln(n); For i:=2 To n Do Begin nguyento:=True; j:=2; While nguyento And (j <i) Do Begin If (i Mod j)=0 Then nguyento:=False; j:=j+1; End; If nguyento Then Write(i:4); End; Writeln; Writeln(' Bam phim <Enter> de ket thuc'); Readln End. +;> FG* Program uoc_so; Var i,n:Integer; [...]... so1,so2,so3,so4,max,min:Integer; Begin Writeln('TIM SO LON NHAT VA SO NHO NHAT'); Writeln(' -'); Write('-Nhap so thu nhat: '); Readln(so1); Write('-Nhap so thu hai : '); Readln(so2); Write('-Nhap so thu ba : '); Readln(so3); Write('-Nhap so thu tu : '); Readln(so4); max:=so1; min:=so1; If max < so2 Then max:=so2 Else min:=so2; If max < so3 Then max:=so3 Else min:=so3; If max < so4 Then max:=so4;... End 241 /Ma trận chuyển vị: Program Ma_tran_Chuyen_Vi; Uses Crt; Const Max=10; Var a:Array[1 Max, 1 Max] Of Integer; Procedure Tao; Var j,k:Integer; Begin Randomize; For k:=1 To Max Do For j:= 1 To Max Do a[k,j]:=Random(100); End; { } Procedure Xuat; Var k,j:Integer; Begin Window(5,3,36, 24) ; For k:=1 to Max Do Begin For j:=1 To Max Do Write(a[k,j]:3); Writeln(#10); End; Window (45 ,3,76, 24) ;... max:=so1; min:=so1; If max < so2 Then max:=so2 Else min:=so2; If max < so3 Then max:=so3 Else min:=so3; If max < so4 Then max:=so4; Writeln; Writeln('+So lon nhat trong 4 so: ',so1,',',so2,',',so3,',',so4,' la: ',max); Writeln('+Va so nho nhat trong 4 so do la : ',min); Writeln; Writeln(' Bam phim de ket thuc'); Readln End 220/Tính độ dài vectơ: Program Tinh_do_dai_vec_to; Var x,y,z:Integer; l:Real;... '); Until Readkey = #27; END 244 /Bản ghi và con trỏ: Program Ban_ghi_va_Con_Tro; Uses Crt; TYPE ConTro = ^LyLich; LyLich = RECORD HoLot : String[17]; Ten : String[7]; BacLuong,PhuCap,Tong : LongInt; Next : ConTro; End; VAR First, Last, Newp : ConTro; Ch : Char; i : Integer; Begin ClrScr; GoToXY(5,25); Write('Bam nut bat ky de tiep tuc Bam de dung '); Window(1,1,80, 24) ; Writeln('** CHUONG TRINH... ',MemAvail,' bytes trong'); Writeln; New(p1); P1^ :=12 345 ; Writeln('-Noi dung cua bien dong P1 la: ',P1^); Writeln('-Sau khi cap phat bo nho cho bien dong P1 (kieu Integer)'); Writeln('Vung nho Heap con: ',MemAvail,' bytes trong'); Writeln; k := Sizeof(p2^); GetMem(p2,Sizeof(p2^)); P2^ :='Nha sach Minh Khai, 249 Nguyen Thi Minh Khai, Q1, Tel 8.331.1 24' ; Writeln('-Noi dung cua bien dong P2 la: ',P2^);... Do Write('*'); Writeln; Writeln; Writeln(' Bam phim de ket thuc'); Readln End 240 /Xếp loại học tập: Program Phan_loai; Var ten:String; diem:Integer; Begin Writeln('XEP LOAI HOC TAP'); Writeln(' '); Write('-Cho biet ten: '); Readln(ten); Write('-Cho biet diem: '); Readln(diem); Case diem Of 0,1,2,3 ,4: Begin Writeln('+Hoc sinh: ',ten); Writeln('+So diem : ',diem); Writeln('+Xep loai... bien dong} Writeln('-p^ = ',p^); Writeln('-q^ = ',q^); Writeln; Writeln(' Vung nho bay gio la: ',MemAvail,' bytes'); Writeln; Writeln('-Buoc 4: Giai phong vung nho '); Dispose(p); Dispose(q); Writeln; Writeln(' Vung nho bay gio la: ',MemAvail,' bytes'); Readln End 246 /Thủ tục FREEMEN & DISPOSE: Program Thu_Tuc_FreeMem_Dispose; VAR p1 : ^Integer; p2 : ^String; p3 : ^Real; k : Word; Begin Writeln('THU... Writeln(' '); Tao; Xuat; Readln END 242 /Giải thuật quicksort: Program Gt_QuickSort; Uses Crt; Const Max=1000; Type Mang = Array[1 Max] Of Integer; Var a:Mang; i:Integer; { -} Procedure Hoanvi(Var m,n : Integer); Var Tam:Byte; Begin Tam:=m; m:=n; n:=Tam; End; { -} Procedure Xuat; Var i:Integer; Begin ClrScr; For i:= 1 to Max Do Begin If i Mod 240 =0 Then Readln; Write(' ',a[i]:6,'... Writeln; Release(p); Writeln('-Sau khi Xoa cac bien dong P2 (kieu String) va P3 (kieu Real)'); Writeln('Vung nho Heap bay gio la: ',MemAvail,' bytes trong'); Readln End 249 /Danh sách vòng: Program Danh_Sach_Vong; Uses Crt; TYPE Chuoi = String[ 24] ; NodePtr = ^Node; Node = RECORD Doivien : Chuoi; Next : NodePtr; End; VAR R : NodePtr; N : Word; HeapTop : Pointer; { } Procedure Append(St :... Function Date.StrDate; Var Strdd,Strmm,Stryy : String [4] ; Begin Str(Day,Strdd); Str(Month,Strmm); Str(Year,Stryy); StrDate := Strdd + '/'+ Strmm + '/' + Stryy; End; { } BEGIN Writeln('DINH NGHIA KIEU CHA, KHONG DINH NGHIA KIEU CON'); Writeln(' Xem ngay hien hanh cua may'); Writeln(' '); Writeln; Regs.Ah := 42 ; MsDos(Regs); With Regs Do Today.Init(dl, dh, cx); Writeln('-Hom . Tam:Real; Begin Tam:=Int((m- 14. 0)/12.0); Julian:=d-32075.0+ Int( 146 1.0*(y +48 00.0+Tam) /4. 0+ Int(367.0*(m-2.0-Tam*12.0)/12.0)- Int(3.0*Int(y +49 00.00+Tam)/100.0) /4. 0) End; (* *) BEGIN {$R+} . Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 4 Program Lam_tron; Var so:Real; le:Integer; (* *) . songay:=31; 4, 6,9,11 : songay:=30; 2 :Case nam Mod 4 Of 1,2,3 :songay:=28; 0 :songay:=29; End; End; If songay >=30 Then Writeln('+Thang:',thang:3,', nam: ',luu :4, ',
Ngày đăng: 10/05/2015, 08:00
Xem thêm: Bài tập Pascal_Phần 4
