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 [email protected]) 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ø <20 la : ( gia tri ) ;Tong cua chung la : ( gia tri ) GIAÛI Var Tong , So : Real ; I , N , Dem : Integer ; BEGIN Write (' Bao nhieu so : ') ; Readln ( N ) ; Tong := 0 ; Dem := 0 ; For I := 1 To N Do Begin Write (' So = ') ; Readln ( So ) ; If ( So > 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 [email protected]) Bài tập Pascal có lời giải 2 End ; Writeln (' So cac so >10 va <20 la : ', Dem ) ; Writeln (' Tong cua chung la :', Tong ) ; Readln ; END . * Baøi 3 : Nhaäp boán soá a , b , c , d . Haõy tìm giaù trò lôùn nhaát cuûa chuùng vaø gaùn giaù trò lôùn nhaát ñoù cho bieán Max . GIAÛI Var Max , a , b , c , d : Real ; BEGIN Writeln (' Nhap gia tri cua 4 so : ') ; Write (' a = ') ; Readln ( a ) ; Write (' b = ') ; Readln ( b ) ; Write (' c = ') ; Readln ( c ) ; Write (' d = ') ; Readln ( d ) ; Max := a ; If Max < b Then Max := b ; If Max < c Then Max := c ; If Max < d Then Max := d ; Writeln (' Gia tri lon nhat la : ', Max ) ; Readln ; END . * Baøi 4 : Ñoïc ngaøy thaùng naêm , sau ñoù vieát ra maøn hình ñoù laø ngaøy thöù maáy trong tuaàn . GIAÛI Var Thu , Ngay , Thang : Byte ; Nam : Integer ; BEGIN Write (' Doc Ngay Thang Nam : ') ; Readln ( Ngay , Thang , Nam ) ; Nam := 1900 + ( Nam mod 1900 ) ; If Thang < 3 Then Begin Thang := Thang + 12 ; Nam := Nam - 1 ; End ; Thu := Abs ( Ngay + Thang * 2 + ( Thang + 1 ) * 3 div 5 + Nam + Nam div 4 ) mod 7 ; Case Thu Of 0 : Writeln (' Chu Nhat ') ; 1 : Writeln (' Thu Hai ') ;
3. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 3 2 : Writeln (' Thu Ba ') ; 3 : Writeln (' Thu Tu ') ; 4 : Writeln (' Thu Nam ') ; 5 : Writeln (' Thu Sau ') ; 6 : Writeln (' Thu Bay ') ; End ; Readln ; END . * Baøi 5 : Vieát chöông trình : Nhaâp soá baùo danh Nhaäp ñieåm vaên , toaùn , ngoaïi ngöõ In ra maøn hình döôùi daïng : _ Phieáu ñieåm : _ Soá baùo danh : _ Ñieåm vaên : _ Ñieåm toaùn : _ Ñieåm ngoaïi ngöõ : _ Toång soá ñieåm : Baïn ñaõ truùng tuyeån ( hoaëc Baïn ñaõ khoâng truùng tuyeån ) vôùi ñieàu kieän Toång soá ñieåm >= 15 hay ngöôïc laïi . GIAÛI Uses Crt ; Var SBD : Integer; Van , Toan , Ngoaingu , Tongdiem : Real ; BEGIN Clrscr ; Write (' So bao danh : ') ; Readln( SBD ) ; Write (' Diem toan : ') ; Readln( Toan ) ; Write (' Diem ngoai ngu : ') ; Readln( Ngoaingu ) ; Write (' Diem van : ') ; Readln ( Van ) ; Tongdiem := Toan + Van + Ngoaingu ; Clrscr ; Writeln (' Phieu Bao Diem ') ; Writeln (' So bao danh : ', SBD ) ; Writeln (' Diem van : ', Van ) ; Writeln (' Diem toan : ', Toan ) ; Writeln (' Diem ngoai ngu : ', Ngoaingu) ; Writeln (' Tong diem : ', Tongdiem) ; If Tongdiem >= 15 Then Writeln(' Ban da trung tuyen ')
4. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 4 Else Writeln(' Ban khong trung tuyen ') ; Readln ; END . * Baøi 6 : Vieát chöông trình nhaäp hai soá thöïc . Sau ñoù hoûi pheùp tính caàn thöïc hieän vaø in keát quaû cuûa pheùp tính ñoù . Neáu laø ‚+‛ , in keát quaû cuûa toång leân maøn hình . Neáu laø ‚-‛ , in keát quaû cuûa hieäu leân maøn hình . Neáu laø ‚/‛ , in keát quaû cuûa thöông leân maøn hình . Neáu laø ‚*‛ , in keát quaû cuûa tích leân maøn hình . Neáu laø ‚+‛ , in keát quaû cuûa toång leân maøn hình . Neáu laø ‚+‛ , in keát quaû cuûa toång leân maøn hình . GIAÛI Uses Crt ; Var a , b , kq : Real ; Pt : Char ; BEGIN Clrscr ; Write (' a = ') ; Readln( a ) ; Write (' b = ') ; Readln( b ) ; Write (' Phep tinh thuc hien la (+ - * /) : ') ; Readln( Pt ) ; If Pt = '+’ Then kq := a + b ; If Pt = '-’ Then kq := a - b ; If Pt = '*’ Then kq := a * b ; If Pt = '/’ Then kq := a / b ; Write ( a , pt , b , ' = ', kq ) ; Readln ; END . * Baøi 7 : Giaûi vaø bieän luaän phöông trình : x2 + ( m – 2 ) x + 1 = 0 ôû ñaây m laø tham soá thöïc tuyø yù . GIAÛI Uses Crt; Var m , Delta : Real ; BEGIN Clrscr; Write (' m = ') ; Readln( m ) ; Delta := sqr( m-2 ) - 4 ; If Delta < 0 Then Writeln(' Phuong trinh vo nghiem ') Else Begin
5. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 5 If Delta = 0 Then Writeln(' Phuong trinh co nghiem kep X= ', -( m - 2 ) / 2 ) Else Begin Writeln(' Phuong trinh co 2 nghiem : ') ; Writeln (' X1 = ', ( -(m-2) + sqrt(delta) ) / 2 ) ; Writeln (' X2 = ', ( -(m-2) - sqrt(Delta) ) / 2 ) ; End ; End ; Readln ; END . * Baøi 8 : Vieát chöông trình nhaäp hai soá töï nhieân N, M vaø thoâng baùo ‘Dung‘ neáu N , M cuøng tính chaün leõ , trong tröôøng hôïp ngöôïc laïi thì thoâng baùo ‘Sai‘. GIAÛI Uses Crt ; Var N , M : Integer ; Begin Clrscr ; Write(' N , M = ') ; Readln( N , M ) ; If ( (N + M) mod 2 = 0 ) Then Writeln(' Dung ! ') Else Writeln(' Sai ! ') ; Readln ; END . BAØI TAÄP CHÖÔNG 2:VOØNG LAÄP XÑ VAØ KHOÂNG XAÙC ÑÒNH Söû duïng leänh For * Baøi 1 : Laäp trình tính tích caùc soá töï nhieân töø 1 tôùi 10 . GIAÛI Var i : Byte ; (* chæ soá chaïy *) p : word ; (* tích soá *) BEGIN p := 1; (* cho giaù trò ban ñaàu cuûa tích *) For i := 1 to 10 Do (* cho i chaïy töø 1 tôùi 10 *) p := p * i ; (* laàn löôït nhaân i vôùi p *) Write (' 1 * 2 * ... * 10 = ', p ) ; Readln ; END . Baøi 2 :Vieát chöông trình ñeám soá laàn xuaát hieän cuûa caùc kí töï thuoäc baûng chöõ caùi trong 50 laàn goõ kí töï baèng baøn phím (khoâng phaân bieät a vôùi A, b vôùi B …, duøng haøm Upcase ñeå chuyeån ñoåi chöõ thöôøng vôùi chöõ hoa) . GIAÛI
6. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 6 Uses Crt ; Var a : Array[ 'A'..'Z' ] of integer; (* maûng boä ñeám *) ch : char ; (* bieán nhaäp kí töïù *) i : byte ; (* chæ soá cuûa laàn goõ phím *) BEGIN Clrscr ; For ch :='A' to 'Z' Do a[ch] := 0 ; (* xaû boä ñeám *) Writeln (' Go phim 50 lan ') ; For i := 1 To 50 Do (* thöïc hieän 100 laàn *) Begin ch :=Readkey ; (* nhaäp kí töï vaøo Ch khoâng caàn goõ Enter *) ch := Upcase(ch) ; (* Ñoãi chöõ thöôøng thaønh chöõ hoa *) a[ch] := a[ch] + 1 ; End; Writeln (' So lan xuat hien cac ki tu la :') ; For ch :='A' to 'Z' do (* Kieåm tra boä ñeám töø 'A' tôùi 'Z' *) If a[ch] > 0 Then (* Neáu Ch coù xuaát hieän *) Writeln (ch , a[ch] : 4 , ' lan . ') ; (* Vieát ra maøn hình kí töï vaø soá laàn xuaát hieän *) Readln ; END . * Baøi 3 :Cho soá töï nhieân n , haõy laäp trình ñeå tính caùc toång sau : a. a. 1 + 1/22 + 1/32 + … + 1/n2 b. b. 1 + 1/2! + 1/3! + … + 1/n! GIAÛI a) Var n , i : Word ;
7. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 7 S : Real ; BEGIN Write (' Nhap n : ') ; Readln (n) ; S := 0 ; For i := 1 To n Do S := S + 1 / sqr(i) ; Writeln (' S = ', S:0:2) ; Readln ; END . b) Var n , i , j , p : Word ; S : Real ; BEGIN Write (' Nhap n : ') ; Readln(n) ; p := 1 ; s := 0 ; For i :=1 To n Do Begin p := p * i ; (* tính i *) S := S + 1 / p ; End ; Writeln (' S = ', S:0:2) ; Readln ; END . *Baøi 4 : Tính giaù trò cuûa bieåu thöùc sau : ( 1 + 1/12 ) ( 1 + 1/22 ) … ( 1 + 1/n2 ) GIAÛI Var i , n : Byte ; p : Real ; Begin Write(' Nhap n : ') ; Readln (n) ; p := 1 ; For i := 1 To n Do p := p * ( 1 + 1/sqr(i) ) ; Writeln(' p = ', p:10:5 ) ; Readln ; End Söû duïng leänh While * Baøi 5 : Laäp trình tính toång : A = 1 + 1/2 + 1/3 + … + 1/n ôû ñaây n laø soá töï nhieân ñöôïc nhaäp vaøo töø baøn phím . GIAÛI Uses Crt ;
8. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 8 Var i , n : Integer ; tong: Real ; BEGIN Clrscr ; Write (' Cho so tu nhien n : ') ; Readln (n) ; tong :=0 ; i :=1 ; While i <= n Do Begin tong := tong + 1/i ; i := i + 1 ; End ; Writeln (' Tong can tim la : ', tong:12:6 ) ; Readln ; END . * Baøi 6 : Tính haøm luõy thöøa an , ôû ñaây a thöïc vaø n töï nhieân ñöôïc nhaäp vaøo töø baøn phím . GIAÛI Uses Crt ; Var i , n : Integer ; a , giatri : Real ; BEGIN Clrscr ; Write (' Cho so a : ') ; Readln(a) ; Write (' Cho so mu n : ') ; Readln(n) ; i := 1 ; giatri := 1 ; While i <= n Do Begin giatri := giatri * a ; i:= i+1 ; End ; Writeln(' a mu n bang : ', giatri ) ; Readln ; END . * Baøi 7 : Vieát chöông trình nhaäp moät daõy soá toái ña 100 soá , sau ñoù in ra maøn hình caùc soá khaùc nhau . GIAÛI Uses Crt; Var A : Array [1..100] Of Integer; i , j , n : Integer ;
9. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 9 BEGIN Clrscr ; Write(' Do dai cua day so N = ') ; Readln (N) ; For I := 1 To N Do Begin Write ('A[', i , ']= ') ; Readln ( A[i] ) ; End ; Writeln (' Cac so khac nhau la : ') ; Writeln ( A[1] ) ; i := 2 ; While i <= N Do Begin j := 1 ; While ( j < i ) and ( A[j] <> A[i] ) Do inc(j) ; If j = i Then Writeln( A[i] ) ; i :=i + 1 ; End ; Readln ; END . * Baøi 8 : Vieát chöông trình nhaäp moät daõy soá toái ña 100 soá , sau ñoù saép xeáp laïi theo thöù töï taêng daàn . GIAÛI Uses Crt; Var A : Array [1..100] Of Integer ; i , j , n , T : Integer ; BEGIN Clrscr ; Write(' Do dai cua day so N = ') ; Readln (N) ; Writeln (' Nhap day so : ') ; For i := 1 To N Do Begin Write('A[', i ,'] = ') ; Readln ( A[i] ) ; End ; i := 1 ; While (i <= n-1) Do Begin j := i+1; While j<=n do Begin If A[j] < A[i] then Begin T := A[j]; A[j ] := A[i]; A[i] := T ;
10. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 10 End ; j := j + 1; End ; i := i + 1; End ; Writeln(' Day sau khi sap xep : ') ; For i := 1 To N Do Write(A[i] : 4) ; Readln ; END . Söû duïng leänh Repeat * Baøi 9 : Cho moät daõy soá ñöôïc nhaäp töø baøn phím . Haõy vieát chöông trình nhaäp moät soá a roài lieät keâ taát caû caùc phaàn töû trong daõy lôùn hôn a. GIAÛI Uses Crt ; Var b : Array[1..100] Of Real; a : Real ; n , i : Byte ; BEGIN Clrscr ; Write ('Nhap do dai cua day so : ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua day : ') ; For i := 1 To n Do Begin Write (' b[', i ,'] = ') ; Readln( b[i] ) ; End ; Write (' Nhap so thuc a : ') ; Readln(a) ; Writeln (' Cac phan tu lon hon a cua day : ') ; i:=1; Repeat If ( b[i] > a ) Then Writeln (' b[', i ,'] = ', b[i]:8:2 ) ; inc(i) ; Until i > n ; Readln ; END . Baøi 10 : Vieát chöông trình nhaäp moät daõy soá toái ña 50 soá roài in ra maøn hình caùc soá truøng nhau cuûa daõy . GIAÛI Uses crt ; Var a , b : Array[1..50] Of Integer ;
11. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 11 n , m , i , j , k : Byte ; trung : Boolean ; BEGIN Clrscr ; Write (' Nhap do dai cua day so nguyen : ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua day : ') ; For i := 1 To N do Begin Write (' a[', i ,'] = ') ; Readln( a[i] ) ; End ; i := 1 ; m := 0 ; Repeat trung := false ; j := i + 1; Repeat If ( j <= n ) and ( a[i] = a[j] ) Then trung := true ; inc (j) ; Until trung or ( j > n ) ; If trung Then Begin m := m + 1; b[m] := a[i] ; writeln ( b[m] : 4 ) ; End ; inc(i) ; Until i > n ; If m > 1 Then Begin i := 1 ; Repeat j := i + 1 ; Repeat trung := false ; If b[i] = b[j] Then trung := true ; If trung Then Begin If j < m Then For k := j To m - 1 Do b[k] := b[k + 1] ; m := m - 1 ; dec ( j ) ; End ; inc ( j ) ; Until j > m ;
12. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 12 inc ( i ) ; Until i > m ; End ; If m > 0 Then For k := 1 To m Do Write ( b[k] : 4 ) ; Readln ; END . * Baøi 11 : Baïn coù 1000 ñ ñem göûi ngaân haøng vôùi laõi suaát 8%/thaùng . Sau moãi thaùng tieàn laõi ñöôïc nhaäp vaøo ñeå tính laõi suaát thaùng sau . Baïn muoán ñeå daønh cho ñeán khi soá tieàn taêng leân laø x . Vaäy phaûi ñeå trong bao laâu GIAÛI uses crt ; var thang : Byte ; tien , lai , x : Real ; BEGIN clrscr ; writeln (' Chuong trinh tinh thoi gian rut tien lai ') ; write (' So tien lai muon rut ra : ') ; readln(x) ; tien := 1000 ; thang :=1 ; repeat lai := tien * 8 / 100 ; tien := tien + lai ; thang := thang + 1 ; until tien >= x ; writeln (' Ban phai gui tien trong ', thang div 12 , ' nam ', thang mod 12 ,' thang .') ; writeln (' Khi do so tien ban rut ra duoc la ', tien:12:2 ,' dong .') ; readln ; END . * Baøi 12 : Vieát chöông trình tìm ÖSCLN cuûa N soá ñöôïc nhaäp töø baøn phím . GIAÛI Uses crt ; Var a : Array [1..100] Of Integer ; n , i : Byte ; d : integer ; BEGIN Clrscr ; Writeln (' Tim USCLN cua N so :') ; Write (' Nhap so N : ') ; Readln(n) ; Writeln ('Nhap ', N ,' so : ') ; For i := 1 To n Do
13. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 13 Begin Write(' So thu ', i ,' = ') ; Readln( a[i] ) ; End ; For i := 1 To n-1 Do Repeat d := a[i] ; a[i] := a[ i+1 ] mod a[i] ; a[i+1] := d ; Until a[i] = 0 ; Writeln (' USCLN cua ', N ,' so la : ', a[n] ) ; Readln ; END . BAØI TAÄP CHÖÔNG 3:CHÖÔNG TRÌNH CON Baøi 1 : Duøng thuû tuïc chuyeån moät soá töï nhieân n cho tröôùc sang heä cô soá 2 . GIAÛI Procedure Change ( n : integer ; Var St : String ) ; (* thuû tuïc chuyeån soá töï nhieân n cho tröôùc sang heä cô soá 2 vaø ñöôïc löu ôû trong xaâu St *) Type b : Array[0 .. 1] Of Char = ('0' , '1') ; Var du , So : Integer ; S : String ; Begin S := '' ; (* xaâu roãng *) So := n ; Repeat Du := So mod 2 ; So :=So div 2 ; S := b[du] + s ; Until So = 0 ; St := S ; End ; Baøi 2 :Duøng thuû tuïc giaûi phöông trình baäc hai ax2 + bx + c = 0 GIAÛI Uses Crt ; Var a, b, c, x1, x2: real; (*================================*) Procedure Nhapabc(var aa,bb,cc: real); Begin Write('a='); Readln(aa); Write('b='); Readln(bb); Write('c='); Readln(cc); End; (*=================================*)
14. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 14 Procedure GPTB2; Var Delta: real; Begin Delta:=sqr(b)-4*a*c; If Delta<0 then Writeln('Phuong trinh vo nghiem.') Else If Delta=0 then Begin Write('Phuong trinh co nghiem kep : '); Write('x1,2=',-b/(2*a):8:2); End Else Begin x1:=(-b+sqrt(Delta))/(2*a); x2:=(-b-sqrt(Delta))/(2*a); Writeln('Phuong trinh co 2 nghiem phan biet la :'); Writeln('X1=',x1:8:2, 'X2=',x2:8:2); End; End; (*================================*) BEGIN (* CT chính *) Clrscr; Writeln(' Giai Phuong Trinh Bac Hai Voi Cac He So :'); Nhapabc(a,b,c); If a<>0 then GPTB2 Else Writeln(' Khong phai phuong trinh bac hai '); Readln ; END . Baøi 3 : Haõy vieát laïi thuû tuïc Insert ñoái vôùi moät chuoãi kí töï cho tröôùc tuøy yù . GIAÛI Procedure Insert ( St1 : String ; Var St2 : String ;Vt : Byte ) ; (* cheøn xaâu St1 vaøo St2 baét ñaàu töø vò trí Vt *) Var i : Byte ; S : String ; Begin If ( Vt > length(St2) Or ( Vt < 1 ) Then Write(' Khong the chen ra ngoai xau ') ; Else Begin S := '' ; (* xaâu roãng *) For i := 1 To (Vt - 1) Do S := S + St2[i] ; S := S + St1 ; For i := Vt To length(St2) Do S := S + St2[i] ; St2 := S ;
15. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 15 End ; End ; Baøi 4 : Vieát chöông trình thöïc hieän laàn löôït caùc coâng vieäc sau : _ Laäp thuû tuïc nhaäp ba soá thöïc döông a , b , c töø baøn phím . _ Laäp thuû tuïc kieåm tra xem ba soá treân coù laäp thaønh ba caïnh cuûa tam giaùc hay khoâng ? _ Vieát thuû tuïc tính dieän tích cuûa tam giaùc . _ Vieát thuû tuïc tính caùc trung tuyeán cuûa tam giaùc . _ Vieát hoaøn thieän chöông trình chính . GIAÛI Uses Crt; Var a, b, c: real ; (*================================*) Procedure Nhap(Var a, b, c: real); Procedure input (Var a: real; tenbien: Char); Begin Repeat Write('Nhap ' + tenbien+' = '); Readln(a); Until (a>=0); End; Begin (* baét ñaàu thuû tuïc nhaäp *) Input(a, 'a'); Input(b, 'b'); Input(c, 'c'); End; (* keát thuùc thuû tuïc nhaäp *) (*================================*) Procedure Kiemtra(a, b, c: Real); Begin If (a
18. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 18 Vieát thuû tuïc Compare ( S1 , S2 : String ; Var Kq : String ) thöïc hieän coâng vieäc sau : so saùnh hai xaâu S1 vaø S2 , tìm taát caû caùc kí töï coù trong caû hai xaâu treân . Xaâu Kq seõ chöùa taát caû caùc kí töï ñoù , moãi kí töï chæ ñöôïc nhôù moät laàn . GIAÛI Uses Crt; Var xau1,xau2,xau: string; (*==================================*) Procedure compare(s1, s2: string; Var kq: string); Var i: byte; (*===============================*) Function kt(ch: char; st: string): boolean; (* Kieåm tra xem kí töï Ch coù trong xaâu St khoâng . Neáu coù thì haøm traû veà giaù trò True . Neáu khoâng thì haøm traû veà giaù trò False *) Begin kt:=pos(ch,st)<>0; End; (*================================*) Begin (* Thaân cuûa thuû tuïc Compare*) kq:=''; (* Xaâu roãng *) For i:=1 to length(s1) do If (not kt(s1[i],kq)) and (kt(s1[i],s2)) then kq:=concat(kq,s1[i]); End; (*==============================*) BEGIN Clrscr; Writeln('Nhap 2 xau S1 va S2 :'); Write('S1: '); Readln(xau1); Write('S2: '); Readln(xau2); Compare(xau1, xau2, xau); If xau<>'' then Writeln('Xau chung la: ',xau) Else Writeln('Khong co ki tu nao trong ca hai xau '); Write('Nhan ENTER de ket thuc...'); Readln; END . Baøi 8 :
19. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 19 Vieát haøm tính D (St1 , St2) , vôùi U, V laø hai xaâu kí töï baát kì , laø toång soá caùc kí töï khoâng gioáng nhau trong hai xaâu treân , moãi loaïi kí töï chæ ñöôïc nhôù moät laàn . Ví duï D (‘aabba’ , ‘bcdd’) = 2 vì chæ coù hai kí töï a vaø d laø khoâng gioáng nhau trong caùc xaâu treân . GIAÛI Uses Crt; Const M=100; Var S: array[1..M] of string; max, min, i, j, n: byte; (*===============================*) Function D(U,V: string): byte; (*Traû veà toång soá loaïi kí töï khoâng gioáng nhau trong 2 xaâu U vaø V *) Var k, id: byte; s, luu: string; Begin luu:=''; (* Xaâu roãng *) For id:=1 to length(U) do If (pos(U[id],V)=0) and (pos(U[id],luu)=0) then luu:=concat(luu,U[id]); For id:=1 to length(V) do If(pos(V[id],U) = 0) and (pos(V[id],luu)=0) then luu:= concat(luu,V[id]); d:=length(luu); End; (*=================================*) Procedure nhap; Begin Repeat Write('So xau ki tu (>=2):') ; Readln(n); If n<2 then Writeln(
7,'Co ',n,' xau ki tu nen khong the ' + 'so sanh duoc'); Until 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 <= n *) Begin k := m ; m := n ; n := k ; End ; s := 0 ; For k := m To n do s := s + sqr(k) ; tb := s / (n - m + 1) ; Writeln ('Trung binh cong bimh phuong cac so ' + 'nguyen tu m den n la: ', tb:12:2); Readln ; END . Baøi 4 : Vieát chöông trình nhaäp töø baøn phím caùc phaàn töû cuûa moät maûng hai chieàu . Kích thöôùc cuûa maûng ñöôïc nhaäp tröôùc töø baøn phím . Var m , n , i , j : Byte ; a : Array[1..100, 1..100] Of Real; BEGIN Write ('Nhap cac kich thuoc cua mang hai chieu : ') ; Write (' So hang m = ') ; Readln(m) ; Write (' So cot n = ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua mang : ') ; For i := 1 To m Do For j := 1 To n Do Begin Write ('a[', i:2, ', ' , j:2 ,']=') ; Readln(a[i, j]) ;
24. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 24 End ; Readln ; END . Baøi 5 : Daõy soá sau ñöôïc goïi laø daõy Fibonaci : a1 = 1 a2 = 1 a3 = 2 a4 = 3 . . . an = an-1 + an-2 Vieát chöông trình tính 20 soá Fibonaci ñaàu tieân vaø ñöa ra keát quaû vaøo moät maûng 20 phaàn töû . Var a : Array[1..20] Of Byte ; i : Byte ; BEGIN a[1] :=1; a[2] :=1; For i:=3 to 20 do a[i]:=a[i-1]+a[i-2] ; END . Baøi 6 : Daõy soá an ñöôïc ñònh nghóa nhö sau : a1 = 1 a2 = 2 . . . an = 2an-1 + an-2 ( n > 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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<=Length(S) do Begin If S[i]='.' then Begin
31. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 31 j:=i; While (S[i]='.')and(i<=length(S)) do inc(i); dec(i); If (i-j)=1 then insert('.',S,i) Else If (i-j)>2 then Begin Delete(S,j+2,i-j-2); i:=j+1; End; End ; Inc(i); End; Write('Chuoi sau khi bien doi la: ',S); Readln; END . Baøi 3 : Cho soá töï nhieân n vaø moät daõy caùc kí töï S1 , S2 , … , Sn . Haõy tìm soá töï nhieân I ñaàu tieân sao cho caùc kí töï Si , Si+1 ñeàu laø chöõ caùi a . Neáu trong daõy khoâng coù nhöõng caëp nhö vaäy thì thoâng baùo . Var S: string; i: integer; BEGIN Write(' Cho mot xau ki tu : '); Readln(S); i:= pos('aa', S); {tìm vò trí xaâu con 'aa' trong S}
32. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 32 If i<>0 then Writeln(' Ton tai "aa" tai vi tri ', i) Else Writeln(' Khong ton tai .') ; Readln; END . Baøi 4 : Cho soá töï nhieân n vaø daõy caùc kí töï S1 , S2 , … , Sn . Bieát raèng trong daõy coù ít nhaát moät daáu phaåy . Haõy tìm soá töï nhieân i sao cho : a. a. Si laø daáu phaåy ñaàu tieân . b. b. Si laø daáu phaày cuoái cuøng . a ) Var S: string; i: integer; BEGIN Write('Cho mot xau S co dau ",": '); Readln(S); i:= pos(',', S); (* vò trí cuûa daáu ',' trong S *) If i<> 0 then Write(' Vi tri thoa man la: ', i); Readln; END . b ) Var S: string; i: integer; BEGIN Write('Cho mot xau S co dau ",": '); Readln(S); i:= length(S); 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 [email protected]) 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<=(len div 2)) do Begin dx:=(St[i] = St[len - i+1]); inc(i); End; If dx then Write(' St la xau doi xung ') Else Write(' St khong phai la xau doi xung ') ; Readln; END . Baøi 6 : Cho moät xaâu kí töï S . Haõy vieát chöông trình tính xem trong S coù bao nhieâu loaïi kí töï khaùc nhau ( phaân bieät chöõ in hoa vôùi chöõ in thöôøng ) . Ví duï vôùi S laø ‚Pascal‛ ta coù ñaùp soá laø 5 . Var S: string; i, j, dem: integer; t: boolean; BEGIN Write('Cho mot xau ki tu S: '); Readln(S); dem:=0; For i:=1 to length(S) do Begin t:=false; For j:=1 to i-1 do if (S[j]=S[i]) then t:=true; If not t then dem:= dem+1; End; Write('So ki tu khac nhau cua xau S la: ', Dem); Readln; END . Baøi 7 : Vieát chöông trình nhaäp moät xaâu kí töï vaø bieán ñoåi chuùng thaønh toaøn chöõ in hoa . Var S : string; i : integer; BEGIN
34. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 34 Write('Cho mot xau ky tu: '); Readln(S); For i:=1 to length(S) do If S[i] in ['a' ..'z'] then S[i]:= Upcase(S[i]); Write('Chuoi sau khi da bien doi la: ', S); Readln; END . Baøi 8 : Hoï teân moät hoïc sinh ñöôïc nhaäp töø baøn phím . Baïn haõy vieát chöông trình ñieàu chænh laïi caùc kí töï ñaàu cuûa caùc töø ñôn trong teân cuûa hoïc sinh aáy trôû thaønh chöõ in hoa . Uses crt; Const Chu=['a'..'z']; Var Hoten: string; i,len: byte; BEGIN Clrscr; Write('Ho ten='); Readln(Hoten); Len:=length(Hoten); If Hoten[1] in Chu then Hoten[1]:=Upcase(Hoten[1]); For i:=2 to len do If (Hoten[i-1]=
32)and(Hoten[i] in Chu) then Hoten[i]:=Upcase(Hoten[i]); Write('Ho ten sau khi dieu chinh la: ', Hoten); Readln; END . Baøi 9 : Vieát chöông trình nhaäp xaõu kí töï töø baøn phím , sau ñoù goït xaâu laïi baèng caùch caùch xoaù ñi caùc kí töï troáng ôû hai ñaàu cuûa xaâu . Ví duï neáu nhaäp xaâu ‚ Ha noi ‚ , thì keát quaû seõ laø ‚Ha Noi‛ . ar S: String; BEGIN Write('Cho mot xau ky tu: '); Readln(S); While S[1] =

32 do Delete(S,1,1); While (S[length(S)] =

32) do Delete(S,length(S),1); Write('Chuoi sau khi da bien doi la: ', S); Readln; END . BAØI TAÄP CHÖÔNG 6: DÖÕ LIEÄU KIEÅU TAÄP Baøi 1 : Baïn haõy vieát haøm Card(A) ñeám soá phaàn töû cuûa taäp hôïp A cho tröôùc coù kieåu Set Of 0 .. 99 . (* haøm ñeám soá phaàn töû cuûa taäp hôïp *) Uses Crt;
35. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 35 Type Tap=set of 0..99; Const inp='Number.dat'; Var S : Tap; i : byte; Procedure Nhap; Var a: byte; f: text; Begin S:=[]; Assign(f,inp); Reset(f); While not SeekEoF(f) do begin Readln(f,a); If (a>=0)and(a<=99) then S:=S+[a]; End; Close(f); End; Function Card(S: Tap): byte; Var i,n: byte; Begin n:=0; For i:=0 to 99 do If i in S then Inc(n); Card:=n; End; BEGIN Nhap; Clrscr; Write('Tap S co ',Card(S),' phan tu.'); Readln; END. Baøi 2 : Baïn haõy laäp chöông trình taïo moät taäp hôïp caùc soá nguyeân chaün kieåu Byte vaø loaïi khoûi noù caùc soá chia heát cho 3 . Keát quaû theå hieän treân maøn hình . Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99;
36. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 36 lop: string[3]; End ; Var ds: array [1..20] of Danhsach; i,j: byte; f: file of Danhsach; Procedure Doi(i,j: byte); Var tg: Danhsach; Begin tg:=ds[i]; ds[i]:=ds[j]; ds[j]:=tg; End; BEGIN ClrScr; Writeln('Nhap danh sach hoc sinh tu file data.dat : '); Writeln; Assign(f,'data.dat'); Reset(f); For i:=1 to n do Read(f,ds[i]); Close(f); For i:=1 to n-1 do For j:=i+1 to n do begin If (ds[i].ten>ds[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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 [email protected]) 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 (i<=n)and((ds[i].tacgia<>tacgia)or(ds[i].namXB<>namXB)) do i:=i+1;
47. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 47 If (i>n) 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 (i<=n)and(ds[i].tensach<>ten) do i:=i+1; If (i>n) 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 [email protected]) 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<3) then Begin Inc(snnq1,songay); Inc(tsq1); End Else If (thang<6) then Begin Inc(snnq2,songay); Inc(tsq2); End; If (thang<9) then Begin Inc(snnq3,songay); Inc(tsq3);
49. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 49 End ; If (thang<12) then Begin Inc(snnq4,songay); Inc(tsq4); End; End; End; Procedure Inkq; Var i: integer; Begin Writeln('So ngay le trong nam : ',n); Writeln('Tong so ngay nghi le trong nam : ',snn); Writeln; Writeln('So ngay le trong qui 1 : ',tsq1); Writeln('Tong so ngay nghi le trong qui 1 : ',snnq1); Writeln('So ngay le trong qui 2 : ',tsq2); Writeln('Tong so ngay nghi le trong qui 2 : ',snnq2); Writeln('So ngay le trong qui 3 : ',tsq3); Writeln('Tong so ngay nghi le trong qui 3 : ',snnq3); Writeln('So ngay le trong qui 4 : ',tsq4); Writeln('Tong so ngay nghi le trong qui 4 : ',snnq4); Writeln; End; BEGIN Clrscr; Nhap; Tinh_ngay_nghi; Inkq; Write('Ban Enter de ket thuc...'); Readln; END. BAØI TAÄP CHÖÔNG 8: KIEÅU FILE Baøi 1 : Haõy laäp chöông trình taïo moät teäp soá nguyeân chöùa caùc soá nguyeân toá nhoû hôn 10000 theo thöù töï taêng daàn . (* Taïo file soá nguyeân toá nhoû hôn 10000 *) Uses Crt; Const N=10000; Var i , j : Integer; f: File of Integer; a: Array[2..N] of boolean;
50. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 50 BEGIN For i:=2 to N do a[i]:=true; i:=2; Repeat For j:=2 to (N div i) do a[i*j]:=false; Repeat Inc(i) Until a[i] or (i>N); Until i>N; Assign(F,'C:SoNT.dat'); Rewrite(F); For i:=1 to N do If a[i] then Write(F,i); Close(F); clrscr; Write(' Viet ra file "C:SoNT" cac so nguyen to nho hon 10000 '); Readln; END . Baøi 2 : Cho f laø teäp vaên baûn chöùa caùc xaâu 10 kí töï . Haõy laäp chöông trình nhaäp vaø hieån thò noäi dung file ñoù leân maøn hình , moãi xaâu moät doøng , ñaày trang maøn hình thì döøng laïi ñôïi goõ Enter môùi hieån thò trang tieáp theo cho tôùi heát. (* Ghi vaø ñoïc file of String *) Uses Crt; Const INP='FoString.dat'; Type String10 = String[10]; Procedure Ghi; Var f: file of String10; S: String10; Begin Assign(f,INP); Rewrite(f); Writeln('Nhap vao f. Thoi nhap khi S='''' (go Enter)!'); Readln(S); While (S<>'') do Begin Write(f,S); Readln(S); End; Close(f); End; Procedure Doc; Var f: file of String10; S: String10; Begin Clrscr; Assign(f,INP); Reset(f); While Not Eof(f) Do Begin
51. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 51 Read(f,S); Writeln(S); If WhereY=25 then Begin Write('Press Enter to continue..'); Readln; Clrscr; End; End; Close(f); Readln; End; BEGIN Ghi; Doc; END. Baøi 3 : Baïn haõy vieát chöông trình cho pheùp ñoïc döõ lieäu töø baøn phím vaø ghi theâm vaøo cuoái moät teäp caùc baûn ghi . (* Doc vaø ghi vaøo cuoái teäp caùc baûn ghi *) Uses Crt; Const inp='Hocsinh.dat'; Type Hocsinh=Record Ten : String[30]; Tuoi: Byte; End; Var F : file of Hocsinh; Hs: Hocsinh; BEGIN Assign(f,inp); Reset(f); Write('Ho va ten: '); Readln(Hs.Ten); Write('Tuoi : '); Readln(Hs.Tuoi); Seek(f,Filesize(F)); Write(f,Hs); Close(f); END . Baøi 4 : Cho moät vaên baûn chöùa trong moät text file f . Trong vaên baûn , tính töø traùi sang phaûi , töø treân xuoáng döôùi , kí töï # laø kí hieäu xoaù ñi moät töø ñöùng ngay tröôùc noù neáu coù . Ví duï ‘
Ta

oi di ngu

h

hoc’ coù nghóa laø ‘Toi di hoc’ . Baïn haõy vieát chöông trình söûa laïi file f theo quy öôùc treân . (* Söûa vaên baûn *)
52. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 52 Uses Crt; Const fi='vanban.txt'; Var f: text; s: string; ch: char; Procedure docfile ( fi : String ); Var f : text ; Begin Assign(f,fi); Reset(f); while not eof(f) do Begin Read(f,ch); Write(ch); End; close(f) ; writeln ; End ; BEGIN Writeln(' Van ban ban dau doc tu file "vanban.txt" :') ; docfile(fi) ; assign(f,fi) ; reset(f) ; s:=''; Repeat Read(f,ch); If (ch='#')then Delete(s,length(s),1) Else s:=s+ch; Until Eof(f); Close(f); Assign(f,fi); Rewrite(f); Writeln(f,s); Close(f); Writeln(' Van ban sau khi sua chua :') ; docfile(fi) ; Readln; END . Baøi 5 : Cho 2 file f vaø g cuøng kieåu ( nhöng khoâng roõ kieåu naøo ) . Baïn haõy laäp thuû tuïc gaùn noäi dung cuûa file g cho file f. (* Gan hai file *) Uses Crt;
53. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 53 Const f1='calc.ex'; f2='C:calc.exe'; Procedure Copyfile(fi1,fi2: string); Var nread,nbuf: word; buf: array [1..1024] of byte; f1,f2: file; Begin Assign(f1,fi1); Reset(f1,1); Assign(f2,fi2); Rewrite(f2,1); nbuf:=1024; Repeat Blockread(f1,buf,nbuf,nread); Blockwrite(f2,buf,nread); Until nread<>nbuf; Close(f1); Close(f2); End; BEGIN Copyfile(f1,f2); END. Baøi 6 : Cho moät file text ghi laïi moät chöông trình Pascal cuûa moät hoïc sinh . Haõy vieát chöông trình kieåm tra loãi cuûa chöông trình Pascal treân theo caùc caùch sau ñaây : Caùch 1 : Kieåm tra xem soá löôïng caùc daáu ‘ ( daáu môû vaø daáu ñoùng ) coù baèng nhau khoâng ? Caùch 2 : Kieåm tra xem soá löôïng caùc töø Begin vaø End coù baèng nhau khoâng ? (* Dem (') vaø 'Begin' , 'End' *) Uses Crt; Const fi='C8_6.txt'; Function Dem(c: string): integer; Var n,l: integer; f: text; S: string; Begin l:=Length(c); n:=0; Assign(f,fi); Reset(f); While not Eof(f) do Begin Readln(f,S); While pos(c,s)<>0 do Begin Inc(n); Delete(s,pos(c,s),l); End; End;
54. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 54 Close(f); Dem:=n; End; BEGIN Clrscr; Write(' So luong cac dau ( va ) '); If Dem('(')<>Dem(')') then Writeln('khong bang nhau.') Else Writeln('bang nhau.'); Write(' So luong cac tu Begin va End '); If Dem('End')<>Dem('Begin') then Writeln('khong bang nhau.') Else Writeln('bang nhau.'); Readln; END . Baøi 7 : Cho moät file text . Haõy vieát chöông trình ñeám xem file text treân chöùa bao nhieâu töø . ( Chuù yù : theo quy ñònh , caùc töø caùch nhau bôûi moät hay nhieàu daáu caùch ) . (* Ñeám töø *) Uses Crt; Const fi = 'hoten.txt'; Var f: text; s: string; dem: word; BEGIN Clrscr; dem:=0; Assign(f,fi); Reset(f); While not Eof(f) do Begin Readln(f,s); While s[1]=' ' do Delete(s,1,1); While length(s)>0 do Begin Case s[1] of ' ': While (s[1]=' ')and(length(s)>0) do Delete(s,1,1); Else Begin inc(dem); While (s[1]<>' ')and(length(s)>0) do Delete(s,1,1); End; End; End; End; Close(f);
55. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 55 Write(' So tu co trong file hoten.txt la: ',dem); Readln; END. Baøi 8 : Cho moät file text . Vieát chöông trình loaïi boû caùc khoaûng troáng thöøa beân trong file text naøy . (* Cat khoang trong thua *) Uses Crt; Const fi = 'file.inp'; fo = 'C:file.out'; Var inp,out: text; s: string; BEGIN Assign(inp,fi); Reset(inp); Assign(out,fo); Rewrite(out); While not Eof(inp) do Begin Readln(inp,s); While (s[1]=' ')and(Length(s)>0) do Delete(s,1,1); While (s[Length(s)]=' ')and(Length(s)>0) do Delete(s,Length(s),1); While (Length(s)>0)and(pos(' ',s)<>0) do Delete(s,pos(' ',s),1); Writeln(out,s); End; Close(out); Close(inp); END. BAØI TAÄP CHÖÔNG 9: CON TROÛ Baøi 1 : Baïn haõy laäp chöông trình cho pheùp ta nhaäp töø baøn phím moät danh saùch ñöôïc gheùp noái . Sau ñoù gôõ boû moät record khoûi danh saùch . (* Gôõ boû baûn ghi khoûi danh saùch *) Uses Crt; Type ptr=^rec; rec=record name: string[20]; next: ptr; End; Var k : integer; p,l : ptr; Procedure Nhap; Begin
56. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 56 ClrScr; New(p); l:=p; Write('Ten: '); Readln(p^.name); Repeat New(p^.next); p:=p^.next; Write('Ten: '); Readln(p^.name); Until p^.name=''; p^.next:=nil; Write('Vi tri ban ghi can go bo: '); Readln(k); End; Procedure Gobo; Var i: integer; q: Ptr; Begin p:=l; For i:=1 to k do p:=p^.next; (* Tìm vò trí cuoái *) q:=p; p:=l; For i:=3 to k do p:=p^.next; (* Tìm vò trí ñaàu *) If k=1 then l:=q Else p^.next:=q; End; Procedure In_kq; Begin While (l^.next<>nil) do Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Gobo; In_kq; END. Baøi 2 : Baïn haõy laäp chöông trình cho pheùp nhaäp moät danh saùch ñöôïc gheùp noái . Sau ñoù cheøn theâm moät record vaøo danh saùch . (* Cheøn theâm baûn ghi vaøo danh saùch *) Uses Crt; Const inp='C9_2.inp'; Type ptr=^rec;
57. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 57 rec=record name: string[20]; next: ptr; End; Var f: text; k: integer; p,s,l: ptr; Procedure Nhap; Begin Assign(f,inp); Reset(f); New(p); l:=p; While not EoF(f) do Begin Readln(f,p^.name); New(p^.next); p:=p^.next; End; p^.next:=nil; Close(f); New(s); Clrscr; Writeln('Nhap ban ghi can chen: '); Write('Ten: '); Readln(s^.name); Write('Vi tri can chen: '); Readln(k); End; Procedure Chen_rec; Var i: integer; Procedure Cat(Var L: ptr); Begin s^.next:=l; l:=s; End; Begin p:=l; For i:=3 to k do p:=p^.next; (* Tim vi tri *) If k>1 then Cat(p^.next) Else Cat(l); {Cat - Noi} End; Procedure In_kq; Begin While (l^.next<>nil) do Begin
58. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 58 Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Chen_rec; In_kq; END. Baøi 3 : Baïn haõy laäp chöông trình cho pheùp nhaäp moät danh saùch ñöôïc gheùp noái . Sau ñoù ñoåi choã hai record trong danh saùch . (* Ñoåi choã 2 baûn ghi trong danh saùch *) Uses Crt; Const inp='C9_3.txt'; Type ptr=^{rec; rec=record name: string[20]; next: ptr; End; Var f: text; j,k: integer; p,l: ptr; tenj,tenk: string; Procedure Nhap; Begin Assign(f,inp); Reset(f); New(p); l:=p; While not EoF(f) do Begin Readln(f,p}.name); New(p^.next); p:=p^.next; End; p^.next:=nil; Close(f); Clrscr; Write('Nhap vi tri 2 ban ghi can doi cho: '); Readln(j,k); End;
59. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 59 Procedure Doicho; Var i: integer; Begin p:=l; For i:=2 to k do p:=p^.next; tenk:=p^.name; p:=l; For i:=2 to j do p:=p^.next; tenj:=p^.name; p:=l; For i:=2 to k do p:=p^.next; p^.name:=tenj; p:=l; For i:=2 to j do p:=p^.next; p^.name:=tenk; End; Procedure In_kq; Begin While (l^.next<>nil) do Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Doicho; In_kq; END. BAØI TAÄP CHÖÔNG 10: ÑOÀ HOÏA Baøi 1 : Veõ hình chöõ nhaät coù taâm truøng vôùi taâm maøn hình , caùc caïnh song song vaø tæ leâ vôùi caùc caïnh maøn hình , kích thöôùc lôùn daàn theo thôøi gian . (* Hình chöõ nhaät thay ñoåi kích thöôùc *) Uses Crt,Graph; Var Gd,Gm,x,y: Integer; tl: real; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); If GraphResult <> GrOk Then Halt ; tl:=GetMaxY/GetMaxX; SetFillStyle(1,4); For x:=1 to GetMaxX do
60. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 60 Begin y:=round(x*tl); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); Delay(10); End; CloseGraph; END. Baøi 2 : Veõ hình chöõ nhaät nhö treân , kích thöôùc ñieàu khieån ñöôïc . Neáu goõ phím + thì hình lôùn leân , goõ phím – thì nhoû ñi , goõ Enter thì döøng chöông trình . (* Hình chöõ nhaät kích thöôùc ñieàu khieån ñöôïc *) Uses Crt, Graph; Var Gd,Gm,x,y: Integer; tl: real; c: char; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); tl:=GetMaxY/GetMaxX; x:=GetMaxX div 2; y:=round(x*tl); SetFillStyle(1,4); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); Repeat OutTextXY(0,0,'Press Esc to Exit...'); Repeat c:=ReadKey; Until c in [
27,'+','-']; SetFillStyle(1,0); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); If (c='+')and(x0) then Dec(x); y:=round(x*tl); SetFillStyle(1,4); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2);
61. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 61 Until c=
27; CloseGraph; END. Baøi 3 : Moät baøn côø vua hieån thò treân maøn hình . Neáu ñaët moät con haäu ( hình troøn maøu ñoû ) vaøo moät oâ baèng caùch nhaäp teân oâ , chaúng haïn a5 , thì caùc oâ bò con haâu khoáng cheá seõ ñöôïc toâ maøu xanh . Baïn haõy laäp chöông trình thöïc hieän caùc yeâu caàu treân . (* Phaïm vi kieåm soaùt cuûa Con haäu *) Uses Crt,Graph; Const N=8; W=40; X=150; Y=400; Var Gd,Gm,i,Hi: Integer; j,Hj,H: char; S: String; Pattern : FillPatternType; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); OutTextXY(270,430,'Ban co vua'); For i:=1 to N do For j:='a' to chr(Ord('a')+N-1) do Begin If Odd(i+Ord(j)) then SetFillStyle(SolidFill,14) Else SetFillStyle(SolidFill,15); Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W); End; OutTextXY(200,20,'Nhap vi tri con hau:'); Hj:=ReadKey; OutTextXY(370,20,Hj); H:=ReadKey; Hi:=Ord(H)-Ord('0'); OutTextXY(380,20,H); SetColor(4); Circle(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,W div 2-5); GetFillPattern(Pattern); SetFillPattern(Pattern,4); FloodFill(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,4); SetFillStyle(SolidFill,13); For i:=1 to N do For j:='a' to chr(Ord('a')+N-1) do If ((i<>Hi)or(j<>Hj)) and((Abs(i-Hi)=Abs(Ord(j)-Ord(Hj)))or(i=Hi)or(j=Hj)) then Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W);
62. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 62 Readln; CloseGraph; END. Baøi 4 : Veõ ñoàng hoà ñieän töû hoaït ñoäng treân maøn hình . (* Ñoàng hoà ñieän töû *) Uses Crt,Dos,Graph; Var h,m,s,hund: Word; GD,GM: Integer; St: String; Function LeadingZero(w: Word): String; Var s: String; Begin Str(w:0,s); if Length(s)=1 then s:='0'+s; LeadingZero:=s; End; BEGIN GD:=Detect; InitGraph(GD,GM,' '); SetTextStyle(DefaultFont,HorizDir,5); Repeat GetTime(h,m,s,hund); St:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s); SetColor(15); OutTextXY(150,200,St); Delay(1000); SetColor(0); OutTextXY(150,200,St); Until KeyPressed; CloseGraph; END. Baøi 5 : Hieån thò moät ñieåm chuyeån ñoäng ñeàu theo chieàu kim ñoàng hoà treân quyõ ñaïo troøn , taâm laø taâm maøn hình , baùn kính r = 150 .
63. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 63 (* Ñieåm chuyeån ñoäng troøn ñeàu *) Uses Crt, Graph; Const r=150; v=5; Var Gd,Gm,x0,y0,x,y: Integer; a: real; (* goùc *) BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); x0:=GetMaxX div 2; y0:=GetMaxY div 2; PutPixel(x0,y0,4); a:=0; Repeat x:=x0+Round(r*cos(a)); y:=y0+Round(r*sin(a)); PutPixel(x,y,15); Delay(v); PutPixel(x,y,0); a:=a+0.01; Until KeyPressed; CloseGraph; END. Baøi 6 : Hieån thò moät hình chöõ nhaät treân maøn hình , vò trí coù theå ñieàu khieån ñöôïc baèng baøn phím . Goõ caùc phím muõi teân ñeå dòch chuyeån hình ñoù theo caùc höôùng töông öùng . (* dieu khien vi tri cua hinh vuong *) Uses Crt, Graph; Var Gd,Gm,x,y,v: Integer; Pa,Pb: Pointer; Size: Word; c: char; BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); Size:=ImageSize(0,0,20,20); GetMem(Pb,Size); GetImage(0,0,20,20,Pb^);
64. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 64 GetMem(Pa,Size); Bar(0,0,20,20); GetImage(0,0,20,20,Pa^); ClearDevice; x:=300; y:=200; v:=10; c:=
77; Repeat PutImage(x,y,Pa^,NormalPut); Repeat Until KeyPressed; c:=ReadKey; If c=

0 then c:=ReadKey; PutImage(x,y,Pb^,NormalPut); Case c of

72: Dec(y);

75: Dec(x);

77: Inc(x);

80: Inc(y); End; If x>600 then x:=0; If x<0 then x:=600; If y>440 then y:=0; If y<0 then y:=440; Until (c=

27)or(c=

13); CloseGraph; END. Baøi 7 : Veõ hình sau vôùi caùc phoâng chöõ , caùc maøu khaùc nhau : Size 8 Size 16 Size 24 Size 32 Size 40 (* Caùc daïng phoâng chöõ *)
65. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 65 Uses Graph; Const K=3; Var Gd,Gm,Font,Color,Size,i: Integer; S: String; BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); Color:=0; For Font:=0 to 11 do Begin ClearDevice; For i:=1 to 4 do Begin Size:=(i-1)*K+1; Inc(Color); Color:=Color mod 15+1; SetColor(Color); SetTextStyle(Font,HorizDir,Size); Str(Size,S); S:='Size '+S; OutTextXY(100,i*80,S) ; End; Readln; End; CloseGraph; END. Baøi 8 : Veõ heä truïc toaï ñoä vaø ñoà thò haøm soá y = x2 vôùi ñaày ñuû chuù thích . (* Ñoà thò cuûa haøm soá y = Sqr(x) *) Uses Graph; Const X0=320;Y0=300;E=50; Var Gd,Gm,i,j,k: Integer; x,y: real; S: String; BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); Line(100,Y0,550,Y0); {Truc Ox} OutTextXY(540,Y0+10,'x'); For k:=-3 to 3 do
66. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 66 Begin i:=k*E+X0; j:=Y0; Str(k,S); OutTextXY(i-10,j+8,S); Bar(i-1,j-1,i+1,j+1); End; Line(X0,50,X0,370); {Truc Oy} OutTextXY(X0-20,50,'y'); For k:=-1 to 4 do Begin i:=X0; j:=-k*E+Y0; Str(k,S); If k<>0 then OutTextXY(i-20,j,S); Bar(i-1,j-1,i+1,j+1); End; For i:=X0-2*E to X0+2*E do {Do thi} Begin x:=(i-X0)/E; y:=Sqr(x); j:=Round(-y*E+Y0); PutPixel(i,j,10); End; SetTextStyle(1,0,2); OutTextXY(100,400,'Do thi ham so y = Sqr(x):'); Readln; CloseGraph; END. Baøi 9 : Veõ vaø toâ maøu cho ngoâi nhaø sau . Ñaûm baûo khaû naêng baät taét ñieän cho ngoâi nhaø . Neáu goõ phím + thì ñeøn saùng ( cöûa soå coù maøu traéng ) , goõ phím – thì ñeøn taét ( cöûa soá coù maøu ñen ) . (* To mau Ngoi nha *) Uses Crt,Graph; Var Gd,Gm: Integer; Pattern : FillPatternType; c: Char;
67. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 67 BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); GetFillPattern(Pattern); OutTextXY(120,50,'To mau Ngoi nha:'); Rectangle(220,200,420,330); Rectangle(250,230,300,330); Rectangle(330,230,390,280); MoveTo(220,200); Lineto(180,200); Lineto(220,140); Lineto(420,140); Lineto(460,200); Lineto(420,200); SetFillPattern(Pattern,Blue); Floodfill(0,0,White); SetFillPattern(Pattern,4); Floodfill(320,190,White); SetFillPattern(Pattern,8); Floodfill(320,220,White); Repeat Repeat c:=ReadKey; Until c in [
27,'+','-']; If (c='+') then SetFillPattern(Pattern,14) Else If (c='-') then SetFillPattern(Pattern,0);; Floodfill(270,300,White); Floodfill(370,270,White); Until c=

27; CloseGraph; END. MUÏC LUÏC Chöông 1:IF ……..Then …………Else.
68. liệu này các em xem để học (0946873510-Hoàng Nam [email protected]) Bài tập Pascal có lời giải 68

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

7,'Co ',n,' xau ki tu nen khong the ' + 'so sanh duoc'); Until 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;

32 do Delete(S,1,1); While (S[length(S)] =

13 then Write(

7); Until ch=

13 then Write(

7); If ch=

0 then ch:=Readkey; Until ch =

Ta

oi di ngu

h

hoc’ coù nghóa laø ‘Toi di hoc’ . Baïn haõy vieát chöông trình söûa laïi file f theo quy öôùc treân . (* Söûa vaên baûn *)

27,'+','-']; SetFillStyle(1,0); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2); If (c='+')and(x0) then Dec(x); y:=round(x*tl); SetFillStyle(1,4); Bar((GetMaxX-x) div 2,(GetMaxY-y) div 2, (GetMaxX+x) div 2,(GetMaxY+y) div 2);

77; Repeat PutImage(x,y,Pa^,NormalPut); Repeat Until KeyPressed; c:=ReadKey; If c=

0 then c:=ReadKey; PutImage(x,y,Pb^,NormalPut); Case c of

72: Dec(y);

75: Dec(x);

77: Inc(x);

80: Inc(y); End; If x>600 then x:=0; If x<0 then x:=600; If y>440 then y:=0; If y<0 then y:=440; Until (c=

27)or(c=

13); CloseGraph; END. Baøi 7 : Veõ hình sau vôùi caùc phoâng chöõ , caùc maøu khaùc nhau : Size 8 Size 16 Size 24 Size 32 Size 40 (* Caùc daïng phoâng chöõ *)

27,'+','-']; If (c='+') then SetFillPattern(Pattern,14) Else If (c='-') then SetFillPattern(Pattern,0);; Floodfill(270,300,White); Floodfill(370,270,White); Until c=

27; CloseGraph; END. MUÏC LUÏC Chöông 1:IF ……..Then …………Else.

Bài Viết Liên Quan

Quảng Cáo

Có thể bạn quan tâm

Toplist được quan tâm

Quảng cáo

Xem Nhiều

Quảng cáo

Chúng tôi

Điều khoản

Trợ giúp

Mạng xã hội

7,'Co ',n,' xau ki tu nen khong the ' + 'so sanh duoc'); Until 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;