Bài tập lập trình pascal có lời giải

1. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 1 BAØI TAÄP CHÖÔNG 1:CAÂU LEÄNH IF ….THEN… * Baøi 1 : Nhaäp 3 soá a , b , c baát kì . Haõy kieåm tra xem ba soá ñoù coù theå laø ñoä daøi ba caïnh cuûa moät tam giaùc hay khoâng ? Thoâng baùo leân maøn hình ‘ Thoûa maõn ‘, ‘ Khoâng thoûa maõn trong töøng tröôøng hôïp töông öùng . GIAÛI Var a , b , c : Real ; BEGIN Writeln [' Nhap do dai 3 canh cua tam giac : '] ; Write [' a = '] ; Readln [ a ] ; Write [' b = '] ; Readln [ b ] ; Write [' c = '] ; Readln [ c ] ; If [ a + b > c ] and [ b + c > a ] and [ c + a > b ] and [ a > 0 ] and [ b > 0 ] and [ c > 0 ] Then Writeln [' Thoa man : Day la 3 canh cua mot tam giac '] Else Writeln [' Khong thoa man ! '] ; Readln ; END . * Baøi 2 : Nhaäp N soá baát kì . Ñeám caùc soá lôùn hôn 10 vaø nhoû hôn 20 vaø tính toång cuûa chuùng . Sau ñoù , ñöa ra maøn hình :So cac so >10 vaø 10 ] and [ So < 20 ] Then Begin Tong := Tong + So ; Dem := Dem + 1 ; End ;
2. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 2 End ; Writeln [' So cac so >10 va =2]:'] ; Readln[n]; If n=2; Writeln['Nhap ',n,' xau ki tu :']; For i:=1 to n do Begin Write['S',i,'=']; Readln[S[i]]; End; End ; [*===============================*] BEGIN [* Chöông trình chính *] Clrscr; nhap; max:=0; min:=255;
20. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 20 For i:=1 to n-1 do For j:=i+1 to n do Begin If maxd[S[i],S[j]] then min:=d[S[i],S[j]]; End; Write['Max[d[Si,Sj]=',max,' Min[d[Si,Sj]=',min]; Readln; END . Baøi 9 : Vieát chöông trình hoaøn chænh thöïc hieän caùc coâng vieäc cuûa thöïc ñôn sau : 1. 1. Nhaäp döõ lieäu [ nhaäp soá töï nhieân n ] . 2. 2. Phaân tích ra thöøa soá nguyeân toá [ phaân tích n thaønh tích caùc soá nguyeân toá ] . 3. 3. Thoaùt khoûi chöông trình . GIAÛI Uses Crt; Type uoc_nguyen_to=array[1..50] of longint; Var u, N: longint; i, dem: integer; a: uoc_nguyen_to; [*================================*] Procedure nhap[Var NN:longint]; Begin Repeat Write['Nhap N=']; Readln[NN]; Until NN>=0; End; [*=================================*] Procedure viet; Begin If dem=0 then Writeln['So ',N,' khong the phan tich thanh ' + 'tich cua cac so nguyen to'] Else If dem=1 then Writeln[N, '=', a[dem]] Else Begin Write[N,'=']; For i:=1 to dem-1 do Write[a[i],'*']; Writeln[a[dem]]; End; End;
21. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 21 [*================================*] Procedure phantich[N1:longint]; Begin If N1>1 then Begin u:=2; dem:=0; Repeat If [N1 mod u=0] then Begin inc[dem]; a[dem]:=u; N1:=N1 div u; End Else inc[u]; Until N1=1; End Else dem:=0; Viet; End; [*==============================*] BEGIN [* Main Program *] Clrscr; Writeln['Phan tich so N thanh tich cua cac so nguyen to :']; nhap[N]; phantich[N]; Write['Nhan Enter de ket thuc ...']; Readln; END . BAØI TAÄP CHÖÔNG 4: CAÁU TRUÙC DÖÕ LIEÄU MAÛNG Baøi 1 : Giaûi heä phöông trình tuyeán tính hai aån duøng ma traän : a11x + a12y = c1 a21x + a22y = c2 GIAÛI Uses Crt; Var a: array[1..2, 1..2] of real; c: array[1..2] of real; d, dx, dy, x, y: real;
22. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 22 BEGIN Clrscr; Writeln['Giai he phuong tring tuyen tinh hai an:']; Writeln[' a11x+a12y=c1']; Writeln[' a21x+a22y=c2']; Writeln['Nhap cac he so cua he phuong trinh']; Write['a11=']; Readln[a[1,1]]; Write['a12=']; Readln[a[1,2]]; Write['c1=']; Readln[c[1]]; Write['a21=']; Readln[a[2,1]]; Write['a22=']; Readln[a[2,2]]; Write['c2=']; Readln[c[2]]; d:=a[1,1]*a[2,2] - a[2,1] * a[1,2]; dx:=c[1]*a[2,2] - c[2] * a[1,2]; dy:=a[1,1]*c[2] - a[2,1] * c[1]; If d=0 then Writeln[' He vo nghiem hoac vo so nghiem'] Else Begin x:=dx/d; y:=dy/d; Writeln['He co nghiem duy nhat :']; Writeln['x=', x:0:2, ' ; y=', y:0:2]; End ; Readln; END . Baøi 2 : Laäp phöông trình taïo ra moät maûng chöùa baûng cöûu chöông . Uses Crt ; Var a : Array[1..10, 2..9] Of Byte ; i, j : Byte ; BEGIN Clrscr ; For i := 1 To 10 Do For j := 2 To 9 Do a[i, j] := i*j ; Writeln[' Bang cuu chuong : '] ; Writeln ; For i := 1 To 10 Do For j := 2 to 9 do Write [ j:4 , 'x' , i:2 , '=' , a[i , j]:2] ; [* heát 80 coät töï ñoäng xuoáng haøng *] Readln ; END .
23. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 23 Baøi 3 : Vieát chöông trình nhaäp hai soá nguyeân döông m , n . Sau ñoù tính trung bình coäng bình phöông caùc soá nguyeân töø m ñeán n . Var m , n , k , s : Word ; tb : real ; BEGIN Writeln['Nhap 2 so nguyen duong m, n :'] ; Write [' m = '] ; Readln[m] ; Write [' n = '] ; Readln[n]; If m > n Then [* ñoãi choã ñeå m 2 ] Haõy laäp chöông trình tính vaø gaùn giaù trò cuûa daõy vaøo bieán maûng . Var a : Array [1..100] Of Word ; i, N : Byte ; S : Real ; BEGIN Write [' Nhap so N>=2 : '] ; Readln[n] ; a[1] := 1 ; a[2] := 2 ; For i := 3 To N Do a[i] := 2*a[i-1]+a[i-2] ;
25. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 25 S := 0 ; For i := 1 to N do S := S+1/sqr[a[i]] ; Writeln [' S = ', S:12:6] ; Readln ; END . Baøi 7 : Nhaäp soá töï nhieân N vaø vieát chöông trình taïo maûng bao goàm N soá nguyeân toá ñaàu tieân . var a:array[1..100,1..100]of byte; n,i,j,k,l,ba:byte; d:boolean; BEGIN write[' Nhap kich thuoc cua mang hai chieu NxN. N = '];readln[n]; for i:=1 to n do for j:=1 to n do begin ba:=0; repeat d:=FALSE; if j>1 then for k:=1 to j-1 do if a[i,k]=ba then d:=true; if i>1 then for k:=1 to i-1 do if a[k,j]=ba then d:=true;
26. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 26 ba:=ba+1; until not d; a[i,j]:=ba-1; end; for i:=1 to n do for j:=1 to n do write[a[i,j]:8]; readln; END . Baøi 8 : Vieát chöông trình nhaäp moät baûng soá 3 x 3 vôùi ñieàu kieän caùc soá ñöôïc nhaäp seõ hieän treân maøn hình ñuùng taïi vò trí cuûa mình treân baûng soá . Uses Crt; Var a : array[1..3, 1..3] of integer ; i, j: byte ; BEGIN Clrscr; Writeln['Nhap mot bang so nguyen kich thuoc 3x3:']; Gotoxy[10, 4]; Write[1]; Gotoxy[19, 4]; Write[2]; Gotoxy[28, 4]; Write[3]; Gotoxy[5, 6]; Write[1]; Gotoxy[5, 8]; Write[2]; Gotoxy[5,10]; Write[3]; For i:=1 to 3 do For j:=1 to 3 do Begin Gotoxy[9*j-1, 2*i+4]; Read[a[i, j]]; Gotoxy[9*j-1, 2*i+4]; ClrEol; Write[a[i, j]:6]; End; Readln; END .
27. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 27 Baøi 9 : a. a. Vieát chöông trình nhaäp döõ lieäu töø daõy ñoái xöùng vaøo maûng moät chieàu . b. b. Vieát chöông trình nhaäp döõ lieäu laø ma traän ñoái xöùng vaøo maûng hai chieàu . a] Var a: array [1..100] of integer; n, i: byte; Begin Write['Nhap so phan tu cua day doi xung:']; Readln[n]; Writeln['Nhap cac phan tu cua day:']; For i:=1 to [n+1] div 2 do Begin Write['a[', i:2, ']=']; Readln[a[i]]; a[n-i+1] := a[i]; End; Readln ; END ; b] Var a: array [1..100, 1..100] of integer; n, i, j: integer; BEGIN
28. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 28 Write['Nhap kich thuoc cua mang doi xung: ']; Readln[n]; Write['Nhap cac phan tu cua mang:']; For i:=1 to n do For j:=1 to i do Begin Write['a[', i:2, ',', j:2, ']=']; Readln[a[i, j]]; a[j,i]:=a[i,j]; End; Readln ; END ; BAØI TAÄP CHÖÔNG 5: XAÂU KYÙ TÖÏ Baøi 1 : Laäp trình ñeám soá laàn xuaát hieän ôû moãi loaïi kí töï thuoäc baûng chöõ caùi tieáng Anh trong moät xaâu kí töï Str . Var A: array [ 'A'..'Z'] of integer; S: string; ch: char; i: integer; BEGIN Write[' Cho mot xau ki tu : ']; Readln[s]; For ch:= 'A' to 'Z' do A[ch]:=0; For i:=1 to length[s] do Begin If Upcase[S[i]] in [['A'..'Z']] then Begin S[i]:= Upcase[S[i]]; A[S[i]]:= A[S[i]]+1; End; End; For ch:= 'A' to 'Z' do
29. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 29 Writeln['So lan xuat hien cua ',ch,' trong xau la: ', A[ch]:4] ; Readln ; END . Baøi 2 : Cho soá töï nhieân n vaø xaâu coù ñoä daøi n . Haõy bieán ñoåi xaâu ñaõ cho baèng caùch thay ñoåi trong ñoù : a. a. Taát caû caùc daáu ! baèng daáu chaám . b. b. Moãi moät nhoùm caùc daáu chaám lieàn nhau baèng moät daáu chaám . c. c. Moät nhoùm caùc daáu chaám ñöùng lieàn nhau baèng daáu ba chaám . a ] Var S: string; i: byte; BEGIN Write[' Cho mot xau ki tu S = ']; Readln[S]; For i:=1 to length[S] do If S[i] = '!' then S[i]:= '.'; Write[ ' Chuoi sau khi da bien doi la : ', S]; Readln; END . b ] Uses crt; Var S : string; i : byte; BEGIN
30. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 30 Clrscr; Write[' Cho mot xau ki tu S = ']; Readln[S]; i:=1; While i< length[S] do If [S[i]='.']and[S[i+1]='.'] then Delete[S,i,1] Else inc[i]; Write['Chuoi sau khi da bien doi la: ' ,S]; Readln; END . c ] Uses crt; Var S: string; i, j: byte; BEGIN Clrscr; Write['Nhap xau S=']; Readln[S]; i:=1; While i=1]and[S[i] ',' ] do i:=i -1; If i>=1 then Write['So thu tu thoa man la: ', i] Else Write['Khong ton tai.']; Readln; END . Baøi 5 : Vieát chöông trình nhaäp moät xaâu kí töï , sau ñoù chæ ra xem xaâu ñoù coù phaûi laø xaâu ñoái xöùng khoâng [ xaâu ñoái xöùng laø xaâu coù caùc kí töï gioáng nhau vaø ñoái xöùng nhau qua ñieåm giöõa xaâu , ví duï ‘ABBA’ hoaëc ‘ABCBA’ ] . Uses Crt; Var St : string; dx : Boolean;
33. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 33 i, len: byte; BEGIN Clrscr; Write[' Nhap xau St = ']; Readln[St]; dx:= True; i:=1; len:= Length[St]; While dx and [i=0]and[ads[j].ten] then Doi[i,j] Else If [ds[i].ten=ds[j].ten]and[ds[i].holot>ds[j].holot] then Doi[i,j]; end; Writeln['Danh sach hoc sinh:']; For i:=1 to n do With ds[i] do Writeln[holot:20,ten:11,tuoi:4,lop:5]; Writeln; Write['Bam Enter de ket thuc...']; Readln; END. Baøi 3 : Xeùt chöông trình sau : Program B4 ; Var Thoat : Set Of Char = [‘e’ , ’E’] ; BEGIN Write [‘ Hay go E de ket thuc : ‘] ; Repeat
37. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 37 Ch := Readkey ; Until Ch in thoat ; END . Haõy tìm vaø söûa loãi trong chöông trình ñoù . Uses Crt; Const thoat: set of char=['e','E']; Var ch: char; BEGIN Write['Hay go E de thoat khoi chuong trinh: ']; Repeat ch:=readkey; Until ch in thoat; END . Baøi 4 : Baïn haõy laäp chöông trình hieån thò moät menu daïng sau treân maøn hình 1. Xem 2. 2. Sua chua 3. 3. Loai bo 4. 4. Nhap them 5. 5. Thoat Lua chon cua ban : _ Sau ñoù ñôïi goõ phím . Chöông trình phaûi ñôïi cho tôùi khi phím goõ vaøo laø moät trong caùc chöõ soá 1 .. 5 hoaëc caùc chöõ caùi ñaàu cuûa caùc tuyø choïn thì thoâng baùo phím goõ vaøo hôïp leä vaø keát thuùc chöông trình . Trong chöông trình phaûi duøng moät taäp hôïp ñeå kieåm tra vieäc nhaäp giaù trò cho bieán töø baøn phím . [* Hieån thò menu *] Uses Crt; Const menu: set of char = ['1'..'5','X','S','L','N','T']; Var ch: char; BEGIN Clrscr; Writeln[' 1. Xem ']; Writeln[' 2. Sua chua ']; Writeln[' 3. Loai bo ']; Writeln[' 4. Nhap them']; Writeln[' 5. Thoat '];
38. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 38 Write['Lua chon cua ban: ']; Repeat ch:=readkey; ch:=Upcase[ch]; Until ch in menu; Writeln; Write['Ban da chon:']; Case ch of '1','X': Writeln[' 1. Xem ']; '2','S': Writeln[' 2. Sua chua ']; '3','L': Writeln[' 3. Loai bo ']; '4','N': Writeln[' 4. Nhap them']; '5','T': Writeln[' 5. Thoat ']; End; Readln; END. Baøi 5 : Haõy laäp chöông trình nhaäp vaøo moät xaâu nhò phaân . Caùc kí töï nhaäp vaøo khoâng hôïp leä bò boû qua . [* nhaäp moät xaâu nhò phaân *] Uses Crt; Const bit : set of char= ['0','1']; Var ch: char; st: string; BEGIN Clrscr; st:=''; Write['Nhap vao mot xau nhi phan : ']; Repeat ch:= Readkey; If ch in bit then begin st:=st+ch; Write[ch]; end Else If ch
13 then Write[

7]; Until ch=

13; Readln; END. Baøi 6 : Haõy laäp chöông trình nhaäp vaøo moät xaâu kí töï töø baøn phím . Yeâu caàu caùc kí töï nhaäp vaøo phaûi laø caùc chöõ caùi thuoäc baûng chöõ caùi tieáng Anh , boû qua caùc phím khaùc . [* Nhaäp moät xaâu toaøn caùc chöõ caùi *] Uses Crt; Const A:set of char=['a'..'z','A'..'Z']; Var ch: char;
39. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 39 st: string; BEGIN Clrscr; st:=''; Writeln['Nhap vao mot xau toan cac chu cai:']; Repeat ch:=Readkey; If ch in A then begin st:=st+ch; write[ch]; End Else if ch
13 then Write[

7]; If ch=

0 then ch:=Readkey; Until ch =

13; END . Baøi 7 : Vieát chöông trình coù chöùc naêng theâm phaàn töû vaøo taäp hôïp tröïc tieáp töø baøn phím vaø loaïi bôùt phaàn töû khoûi taäp hôïp cuõng tröïc tieáp töø baøn phím . [* loai bo cac phan tu khoi tap hop *] Uses Crt; Var tap: set of char; ch: char; BEGIN tap:=[]; Writeln['Nhap cac phan tu cho mot tap hop cac ki tu: ']; Repeat ch:=ReadKey; tap:=tap+[ch]; Writeln[ch]; Until not[ch in ['a'..'z']]; Writeln['Cac phan tu cua tap hop la:']; For ch:='a' to 'z' do If ch in tap then Write[ch,' ']; Writeln; Writeln['Ban muon bo cac phan tu nao khoi tap hop:']; Repeat ch:=ReadKey; tap:=tap-[ch]; Writeln[ch]; Until not[ch in ['a'..'z']]; Writeln['Cac phan tu con lai cua tap hop la:']; For ch:='a' to 'z' do
40. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 40 If ch in tap then Write[ch,' ']; Readln; END . BAØI TAÄP CHÖÔNG 7: KIEÅU RECORD Baøi 1 : Thoâng tin veà moãi hoïc sinh goàm :  Hoï ñeäm : moät xaâu 25 kí töï .  Teân : moät xaâu 10 kí töï .  Tuoåi : moät soá nguyeân hai chöõ soá .  Lôùp : moät xaâu hai chöõ soá vaø moät chöõ caùi vieát hoa Haõy laäp chöông trình nhaäp töø baøn phím danh saùch moät lôùp 15 hoïc sinh vaøo moät maûng baûn ghi . Sau ñoù hieån thò danh saùch leân maøn hình , moãi ngöôøi moät doøng . [* Nhaäp danh saùch hoïc sinh töø baøn phím *] Uses Crt; Const n=15; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; End; Var ds: array [1..n] of Danhsach; i : byte; BEGIN ClrScr; Writeln['Hay nhap danh sach hoc sinh : ']; Writeln; For i:=1 to n do Begin Writeln['Thong tin hoc sinh thu ',i]; Write['Cho ho lot : ']; Readln[ds[i].holot]; Write['Cho ten : ']; Readln[ds[i].ten]; Write['Cho tuoi : ']; Readln[ds[i].tuoi]; Write['Cho lop : ']; Readln[ds[i].lop]; Writeln; End; Writeln['Danh sach hoc sinh :']; For i:=1 to n do With ds[i] do Writeln[holot:20,ten:10,tuoi:4,lop:5]; Writeln;
41. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 41 Write['Bam Enter de ket thuc...']; Readln; END. Baøi 2 : Thoâng tin veà moãi hoïc sinh laø moät baûn ghi goàm caùc tröôøng :  Hoïñeäm : moät xaâu 25 kí töï .  Teân : moät xaâu 10 kí töï .  Tuoåi : moät soá nguyeân hai chöõ soá .  Lôùp : moät xaâu hai chöõ soá vaø moät chöõ caùi vieát hoa Moät file baûn ghi chöùa moät danh saùch moät lôùp goàm 20 hoïc sinh . Haõy laäp chöông trình hieån thò danh saùch leân maøn hình , moãi ngöôøi moät doøng . [* Doc tu mot file ban ghi *] Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; end; Var ds: Danhsach; i: byte; f: file of Danhsach; BEGIN ClrScr; Writeln['Danh sach hoc sinh tu file bai2.dat']; Writeln; Assign[f,'bai2.dat']; Reset[f]; For i:=1 to n do Begin Read[f,ds]; With ds do Writeln[holot:20,ten:11,tuoi:4,lop:5]; End; Close[f]; Writeln; Write['Bam Enter de ket thuc...']; Readln; END . Baøi 3 : Moät file baûn ghi chöùa moät danh saùch hoïc sinh , thoâng tin veà moãi hoïc sinh gioáng nhö baøi treân . Haõy laäp chöông trình taïo moät file baûn ghi khaùc chöùa danh saùch ñoù , moãi baûn ghi goàm caùc tröôøng :
42. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 42  Hoïteân : moät xaâu 35 kí töï .  Tuoåi : moät soá nguyeân hai chöõ soá .  Khoái : moät soá nguyeân hai chöõ soá .  Lôùp : moät chöõ caùi vieát hoa [* Doi kieu ban ghi *] Uses Crt; Type Danhsach1=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; End; Danhsach2=record hoten: string[35]; tuoi: byte; khoi: byte; lop: char; End; Var ds1 : Danhsach1; ds2 : Danhsach2; f1 : file of Danhsach1; f2 : file of Danhsach2; c : integer;
43. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 43 BEGIN ClrScr; Writeln['Ghi tu file bai3.dat sang bai3n.dat:']; Writeln; Assign[f1,'bai3.dat']; Reset[f1]; Assign[f2,'bai3n.dat']; Rewrite[f2]; While not Eof[f1] do Begin Read[f1,ds1]; With ds1 do Begin ds2.hoten:=holot+ten; val[copy[lop,1,2],ds2.khoi,c]; ds2.tuoi:=tuoi; ds2.lop:=UpCase[lop[3]]; Write[f2,ds2]; End; End; Close[f1]; Close[f2]; Writeln; Writeln['Bam Enter de ket thuc!']; Readln;
44. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 44 END . Baøi 4 : Moät file baûn ghi chöùa moät danh saùch hoïc sinh PTTH , thoâng tin veà moãi hoïc sinh ngoaøi caùc tröôøng Hoïñeäm , Teân , Tuoåi , Lôùp gioáng nhö caùc baøi treân coøn coù theâm tröôøng Ñieåm chöùa ñieåm trung bình cuûa hoïc sinh trong naêm hoïc . Haõy laäp chöông trình : a. a. Hieån thò leân maøn hình danh saùch nhöõng hoïc sinh gioûi nhaát cuûa tröôøng laø nhöõng baïn coù ñieåm trung bình töø 8.0 trôû leân vaø cao nhaát trong khoái . b. b. Laäp danh saùch hoïc sinh trong naêm hoïc môùi , bieát moät hoïc sinh coù ñieåm trung bình töø 5.0 trôû leân thì ñöôïc leân lôùp . Chuù yù : lôùp 10A leân lôùp 11A , lôùp 11A leân 12A ... Keát quaû chöùa trong file . [* Khen thuong va len lop *] Uses Crt; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; diem: real; End; Var ds: array [1..100] of Danhsach; f: file of Danhsach; n: integer; Procedure Nhap; Begin Assign[f,'bai4.dat']; Reset[f]; n:=0; While not Eof[f] do Begin n:=n+1; Read[f,ds[n]]; End; Close[f]; End; Procedure Timgioi; Var i: integer; max10,max11,max12: real; l: string; Begin max10:=0; max11:=0; max12:=0; For i:=1 to n do With ds[i] do
45. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 45 Begin l:=copy[lop,1,2]; If [l='10']and[diem>max10]and[diem>8.0] then max10:=diem Else If [l='11']and[diem>max11]and[diem>8.0] then max11:=diem Else If [l='12']and[diem>max12]and[diem>8.0] then max12:=diem; End; Writeln['Hoc sinh gioi nhat khoi 10 : ']; For i:=1 to n do With ds[i] do If [copy[lop,1,2]='10']and[diem>=max10] then Writeln[holot:20,ten:10,tuoi:4,lop:5,diem:5:1]; Writeln['Hoc sinh gioi nhat khoi 11 : ']; For i:=1 to n do With ds[i] do If [copy[lop,1,2]='11']and[diem>=max11] then Writeln[holot:20,ten:10,tuoi:4,lop:5,diem:5:1]; Writeln['Hoc sinh gioi nhat khoi 12 : ']; For i:=1 to n do With ds[i] do If [copy[lop,1,2]='12']and[diem>=max12] then Writeln[holot:20,ten:10,tuoi:4,lop:5,diem:5:1]; End; Procedure Lenlop; Var i: integer; l: string; f: file of Danhsach; Begin For i:=1 to n do With ds[i] do Begin l:=copy[lop,1,2]; If [l='10']and[diem>=5.0] then lop:='11'+lop[3] Else If [l='11']and[diem>=5.0] then lop:='12'+lop[3] Else If [l='12']and[diem>=5.0] then lop:='DTN'; End; Assign[f,'bai4n.dat']; Rewrite[f]; For i:=1 to n do With ds[i] do If lop'DTN' then Write[f,ds[i]]; Close[f]; End; BEGIN ClrScr; Nhap; Timgioi; Lenlop; Write['Bam ENTER de ket thuc...']; Readln;
46. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 46 END . Baøi 5 : Cho file baûn ghi f chöùa döõ lieäu veà kho saùch , döõ lieäu veà moãi cuoán saùch ñöôïc chöùa trong moät baûn ghi goàm 3 tröôøng mang thoâng tin veà :  Hoï teân taùc giaû : moät xaâu 26 kí töï .  Teân saùch : moät xaâu 40 kí töï .  Naêm xuaát baûn : moät soá nguyeân 4 chöõ soá . Haêy laäp chöông trình nhaäp döõ lieäu vaøo kho saùch , sau ñoù tìm ra :  Nhöõng cuoán saùch cuûa moät taùc giaû cho tröôùc xuaát baûn vaøo moät naêm cho tröôùc .  Nhöõng cuoán saùch coù teân cho tröôùc . Keát quaû hieän treân maøn hình. [* Tim kiem tren ban ghi *] Uses Crt; Type Danhsach=record Tacgia: string[26]; Tensach: string[40]; NamXB: integer; End; Var ds: array [1..100] of Danhsach; n : integer; f : file of Danhsach; M: Danhsach; Procedure Nhap; Begin n:=0; Assign[f,'bai5.dat']; Reset[f]; While not Eof[f] do Begin Inc[n]; Read[f,ds[n]]; End; Close[f]; End; Procedure TheoTG; Var tacgia: string; namXB: integer; i: integer; Begin Write['Cho ten tac gia : ']; Readln[M.tacgia]; Write['Cho nam xuat ban : ']; Readln[M.NamXB]; i:=1; While [in] then Writeln['Khong tim duoc'] Else Writeln[ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6]; End; Procedure TheoTS; Var ten: string; i: integer; Begin Write['Cho ten sach : ']; Readln[ten]; i:=1; While [in] then Writeln['Khong tim duoc'] Else Writeln[ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6]; End; Procedure Timkiem; Var c:char; Begin Writeln['1. Tim kiem theo tac gia va nam xuat ban.']; Writeln['2. Tim kiem theo ten sach']; Writeln; Write['Ban chon [1/2] : ']; Repeat c:=Readkey; Until pos[c,'12']>0; Writeln[c]; If c='1' then TheoTG Else TheoTS; End; BEGIN ClrScr; Nhap; Timkiem; Write['Ban Enter de ket thuc...']; Readln; END. Baøi 6 : File baûn ghi F chöùa danh saùch caùc ngaøy leã trong moät naêm , moãi baûn ghi goàm ngaøy thaùng , teân ngaøy leã vaø soá ngaøy ñöôïc nghæ . Haõy laäp chöông trình nhaäp danh saùch caùc ngaøy leã vaø tính :  Toång soá caùc ngaøy leã vaø toång soá caùc ngaøy nghæ leã trong naêm .  Toång soá caùc ngaøy leã vaø toång soá caùc ngaøy nghæ leã trong quí 1 , quí 2 , … Keát quaû theå hieän treân maøn hình . [* Tinh so ngay le va ngay nghi trong nam ,qui *] Uses Crt;
48. liệu này các em xem để học [0946873510-Hoàng Nam Trung-mientrung19@gmail.com] Bài tập Pascal có lời giải 48 Type Danhsach=record ngay: byte; thang: byte; ten: string[15]; songay: integer; end; Var ds: array [1..100] of Danhsach; n: integer; f: file of Danhsach; snn,snnq1,snnq2,snnq3,snnq4: integer; tsq1,tsq2,tsq3,tsq4: integer; Procedure Nhap; Begin n:=0; Assign[f,'bai6.dat']; Reset[f]; While not Eof[f] do Begin Inc[n]; Read[f,ds[n]]; End; Close[f]; End; Procedure Tinh_ngay_nghi; Var i: integer; Begin snn:=0; snnq1:=0; tsq1:=0; snnq2:=0; tsq2:=0; snnq3:=0; tsq3:=0; snnq4:=0; tsq4:=0; For i:=1 to n do With ds[i] do Begin Inc[snn,songay]; If [thang