bai tap Pascal hayco dap an

  Lớp : một xâu hai chữ số và một chữ cái viết hoa Hãy lập chương trình nhập từ bàn phím danh sách một lớp 15 học sinh vào một mảng bản ghi.. Sau đó hiển thị danh sách lên màn hình , m[r]

Bài tập chương 1: CÚ LỆNH IF ….THEN… * Bài : Nhập ba số a,b,c bất kì Hãy kiểm tra xem ba số nó có thể là độ dài tam giác hay tam giác không? Thông báo lên màn hình “thỏa mãn” hay ‘ Không thỏa mãn” GIẢI: Var a , b , c : Real ; BEGIN Writeln (' Nhap dai 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 > ) and ( b > ) and ( c > ) Then Writeln (' Thoa man : Day la canh cua mot tam giac ') Else Writeln (' Khong thoa man ! ') ; Readln ; END * BÀI : Nhập N số bất kì Nếu các số lớn 10 và nhỏ 20 thì tính tổng chúng Sau đó, in màn hình :So cac so >10 và <20 là : ( gia tri ) ;Tong cua chung la : ( gia tri ) GIải Var Tong , So : Real ; I , N , Dem : Integer ; BEGIN Write (' Bao nhieu so : ') ; Readln ( N ) ; Tong := ; Dem := ; For I := To N Do Begin Write (' So = ') ; Readln ( So ) ; If ( So > 10 ) and ( So < 20 ) Then Begin Tong := Tong + So ; Dem := Dem + ; End ; End ; Writeln (' So cac so >10 va <20 la : ', Dem ) ; Writeln (' Tong cua chung la :', Tong ) ; Readln ; END * Bài : Nhập số a , b , c , d Hãy tìm giá trị lớn chúng và gán gi trị lớn cho biến Max GIẢI: Var Max , a , b , c , d : Real ; BEGIN Writeln (' Nhap gia tri cua 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 * Bài : Nêu ngày tháng năm, sau đó viết màn hình các thứ tuần GIẢ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 < Then Begin Thang := Thang + 12 ; Nam := Nam - ; End ; Thu := Abs ( Ngay + Thang * + ( Thang + ) * div + Nam + Nam div ) mod ; Case Thu Of : Writeln (' Chu Nhat ') ; : Writeln (' Thu Hai ') ; : Writeln (' Thu Ba ') ; : Writeln (' Thu Tu ') ; : Writeln (' Thu Nam ') ; : Writeln (' Thu Sau ') ; : Writeln (' Thu Bay ') ; End ; Readln ; END * Bài :Viết chương trình : Nhập số báo danh Nhập điểm văn, toán, ngoại ngữ In màn hình dạng : _ Phiếu điểm: _ Số bo danh : _ Điểm Văn : _ Điểm Tốn : _ Điểm ngoại ngữ : _ Tổng số điểm : Bạn đã trúng tuyển ( Bạn đã không trúng tuyển ) với điều kiện Tổng số điểm >= 15 hay ngược lại GIẢ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 ') Else Writeln(' Ban khong trung tuyen ') ; Readln ; END * Bài :Viết chương trình nhập hai số thực Sau đó hỏi phép tính cần thực và in kết phép tính đó Nếu là “+” , in kết tổng lên màn hình Nếu là “-” , in kết hiệu lên màn hình Nếu là “/” , in kết thương lên màn hình Nếu là “*” , in kết tích lên màn hình Nếu là “+” , in kết tổng lên màn hình Nếu là “+” , in kết tổng lên màn hình GIẢ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 * Bài : Viết chương trình nhập hai số tự nhiên N, M và thông báo ‘Dung‘ N , M cùng tính chẵn lẽ , trường hợp ngược lại thì thông báo ‘Sai‘ GIẢI Uses Crt ; Var N , M : Integer ; Begin Clrscr ; Write(' N , M = ') ; Readln( N , M ) ; If ( (N + M) mod = ) Then Writeln(' Dung ! ') Else Writeln(' Sai ! ') ; Readln ; END BÀI TẬP CHƯƠNG 2:VÒNG LẬP XÁC ĐỊNH VÀ KHÔNG XÁC ĐỊNH Sử dụng lệnh For * Bài : Lập trình tính tích các số tự nhiên từ tới 10 GIẢI Var i : Byte ; (* số chạy *) p : word ; (* tích số *) BEGIN p := 1; (* cho giá trị ban đầu tích *) For i := to 10 Do (* cho i chạy từ tới 10 *) p := p * i ; (* nhân i với p *) Write (' * * * 10 = ', p ) ; Readln ; END Bài :Viết chương trình đếm số lần xuất các kí tự thuộc bảng chữ cái 50 lần gõ kí tự bàn phím (không phân biệt a với A, b với B …, dùng hàm Upcase để chuyển đổi chữ thường với chữ hoa) GIẢI Uses Crt ; Var a : Array[ 'A' 'Z' ] of integer; (* mảng đếm *) ch : char ; (* biến nhập kí tự *) i : byte ; (* số lần gõ phím *) BEGIN Clrscr ; For ch :='A' to 'Z' Do a[ch] := ; (* xả đếm *) Writeln (' Go phim 50 lan ') ; For i := To 50 Do (* thực 100 lần *) Begin ch :=Readkey ; (* nhập kí tự vào Ch không cần gõ Enter *) ch := Upcase(ch) ; (* Đỗi chữ thường thành chữ hoa *) a[ch] := a[ch] + ; End; Writeln (' So lan xuat hien cac ki tu la :') ; For ch :='A' to 'Z' (* Kiểm tra đếm từ 'A' tới 'Z' *) If a[ch] > Then (* Nếu Ch có xuất *) Writeln (ch , a[ch] : , ' lan ') ; (* Viết màn hình kí tự và số lần xuất *) Readln ; END * Bài :Cho số tự nhiên n , hãy lập trình để tính các tổng sau : a a + 1/22 + 1/32 + … + 1/n2 b b + 1/2! + 1/3! + … + 1/n! GIẢI a) Var n , i : Word ; S : Real ; BEGIN Write (' Nhap n : ') ; Readln (n) ; S := ; For i := To n Do S := S + / 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 := ; s := ; For i :=1 To n Do Begin p := p * i ; (* tính i *) S := S + / p ; End ; Writeln (' S = ', S:0:2) ; Readln ; END *Bài : Tính giá trị biểu thức sau : ( + 1/12 ) ( + 1/22 ) … ( + 1/n2 ) GIẢI Var i , n : Byte ; p : Real ; Begin Write(' Nhap n : ') ; Readln (n) ; p := ; For i := To n Do p := p * ( + 1/sqr(i) ) ; Writeln(' p = ', p:10:5 ) ; Readln ; End Sử dụng lệnh While * Bài : Lập trình tính tổng : A = + 1/2 + 1/3 + … + 1/n (ở đây n là số tự nhiên nhập vào từ bàn phím) GIẢI Uses Crt ; 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 + ; End ; Writeln (' Tong can tim la : ', tong:12:6 ) ; Readln ; END * Bài : Tính hàm lũy thừa an , đây a thực và n tự nhiên nhập vào từ bàn phím GIẢ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 := ; giatri := ; While i <= n Do Begin giatri := giatri * a ; i:= i+1 ; End ; Writeln(' a mu n bang : ', giatri ) ; Readln ; END * Bài : Viết chương trình nhập dãy số tối đa 100 số , sau đó in màn hình các số khác GIẢI Uses Crt; Var A : Array [1 100] Of Integer; i , j , n : Integer ; BEGIN Clrscr ; Write(' Do dai cua day so N = ') ; Readln (N) ; For I := To N Do Begin Write ('A[', i , ']= ') ; Readln ( A[i] ) ; End ; Writeln (' Cac so khac la : ') ; Writeln ( A[1] ) ; i := ; While i <= N Do Begin j := ; While ( j < i ) and ( A[j] <> A[i] ) Do inc(j) ; If j = i Then Writeln( A[i] ) ; i :=i + ; End ; Readln ; END * Bài : Viết chương trình nhập dãy số tối đa 100 số , sau đó xếp lại theo thứ tự tăng dần GIẢ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 := To N Do Begin Write('A[', i ,'] = ') ; Readln ( A[i] ) ; End ; i := ; While (i <= n-1) Do Begin j := i+1; While j<=n Begin If A[j] < A[i] then Begin T := A[j]; A[j ] := A[i]; A[i] := T ; End ; j := j + 1; End ; i := i + 1; End ; Writeln(' Day sau sap xep : ') ; For i := To N Do Write(A[i] : 4) ; Readln ; END Sử dụng lệnh Repeat * Bài : Cho dãy số nhập từ bàn phím Hãy viết chương trình nhập số a liệt kê tất các phần tử dãy lớn a GIẢI Uses Crt ; Var b : Array[1 100] Of Real; a : Real ; n , i : Byte ; BEGIN Clrscr ; Write ('Nhap dai cua day so : ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua day : ') ; For i := 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 * Bài 10 : Bạn có 1000 đ đem gửi ngân hàng với lãi suất 8%/tháng Sau tháng tiền lãi nhập vào để tính lãi suất tháng sau Bạn muốn để dành số tiền tăng lên là x Vậy phải để bao lâu GIẢ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 : ') ; readln(x) ; tien := 1000 ; thang :=1 ; repeat lai := tien * / 100 ; tien := tien + lai ; thang := thang + ; until tien >= x ; writeln (' Ban phai gui tien ', thang div 12 , ' nam ', thang mod 12 ,' thang ') ; writeln (' Khi so tien ban rut duoc la ', tien:12:2 ,' dong ') ; readln ; END * Bài 11 : Viết chương trình tìm ƯSCLN N số nhập từ bàn phím GIẢ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 := To n Do Begin Write(' So thu ', i ,' = ') ; Readln( a[i] ) ; End ; For i := To n-1 Do Repeat d := a[i] ; a[i] := a[ i+1 ] mod a[i] ; a[i+1] := d ; Until a[i] = ; Writeln (' USCLN cua ', N ,' so la : ', a[n] ) ; Readln ; END BÀI TẬP CHƯƠNG 3: CẤU TRÚC DỮ LIỆU MẢNG Bài 1:Lập phương trình tạo mảng chứa bảng cửu chương Uses Crt ; Var a : Array[1 10, 9] Of Byte ; i, j : Byte ; BEGIN Clrscr ; For i := To 10 Do For j := To Do a[i, j] := i*j ; Writeln(' Bang cuu chuong : ') ; Writeln ; For i := To 10 Do For j := to Write ( j:4 , 'x' , i:2 , '=' , a[i , j]:2) ; (* hết 80 cột tự động xuống hàng *) Readln ; END Bài : Viết chương trình nhập hai số nguyên dương m , n Sau đó tính trung bình cộng bình phương các số nguyên từ m đến n Var m , n , k , s : Word ; tb : real ; BEGIN Writeln('Nhap so nguyen duong m, n :') ; Write (' m = ') ; Readln(m) ; Write (' n = ') ; Readln(n); If m > n Then (* đỗi chỗ để m <= n *) Begin k := m ; m := n ; n := k ; End ; s := ; For k := m To n 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 Bài : Viết chương trình nhập từ bàn phím các phần tử mảng hai chiều Kích thước mảng nhập trước từ bàn phím Var m , n , i , j : Byte ; a : Array[1 100, 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 := To m Do For j := To n Do Begin Write ('a[', i:2, ', ' , j:2 ,']=') ; Readln(a[i, j]) ; End ; Readln ; END Bài : Dãy số sau gọi là dãy Fibonaci : a1 = a2 = a3 = a4 = an = an-1 + an-2 Viết chương trình tính 20 số Fibonaci đầu tiên và đưa kết vào mảng 20 phần tử Var a : Array[1 20] Of Byte ; i : Byte ; BEGIN a[1] :=1; a[2] :=1; For i:=3 to 20 a[i]:=a[i-1]+a[i-2] ; END Bài 6: Dãy số an định nghĩa sau : a1 = a2 = an = 2an-1 + an-2 ( n > ) Hãy lập chương trình tính và gán giá trị dãy vào biến mảng Var a : Array [1 100] Of Word ; i, N : Byte ; S : Real ; BEGIN Write (' Nhap so N>=2 : ') ; Readln(n) ; a[1] := ; a[2] := ; For i := To N Do a[i] := 2*a[i-1]+a[i-2] ; S := ; For i := to N S := S+1/sqr(a[i]) ; Writeln (' S = ', S:12:6) ; Readln ; END Bài : a.Viết chương trình nhập liệu từ dãy đối xứng vào mảng chiều b Viết chương trình nhập liệu là ma trận đối xứng vào mảng hai chiề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 Begin Write('a[', i:2, ']='); Readln(a[i]); a[n-i+1] := a[i]; End; Readln ; END ; b) Var a: array [1 100, 100] of integer; n, i, j: integer; BEGIN Write('Nhap kich thuoc cua mang doi xung: '); Readln(n); Write('Nhap cac phan tu cua mang:'); For i:=1 to n For j:=1 to i Begin Write('a[', i:2, ',', j:2, ']='); Readln(a[i, j]); a[j,i]:=a[i,j]; End; Readln ; END ; BÀI TẬP CHƯƠNG 4: CHƯƠNG TRÌNH CON Bài : Dùng thủ tục chuyển số tự nhiên n cho trước sang hệ số GIẢI Procedure Change ( n : integer ; Var St : String ) ; (* thủ tục chuyển số tự nhiên n cho trước sang hệ số và lưu xâu St *) Type b : Array[0 1] Of Char = ('0' , '1') ; Var du , So : Integer ; S : String ; Begin S := '' ; (* xâu rỗng *) So := n ; Repeat Du := So mod ; So :=So div ; S := b[du] + s ; Until So = ; St := S ; End ; Bài :Dùng thủ tục giải phương trình bậc hai ax2 + bx + c = GIẢ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; (*=================================*) 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 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 Bài : Hãy viết lại thủ tục Insert chuỗi kí tự cho trước tùy ý GIẢI Procedure Insert ( St1 : String ; Var St2 : String ;Vt : Byte ) ; (* chèn xâu St1 vào St2 vị trí Vt *) Var i : Byte ; S : String ; Begin If ( Vt > length(St2) Or ( Vt < ) Then Write(' Khong the chen ngoai xau ') ; Else Begin S := '' ; (* xâu rỗng *) For i := To (Vt - 1) Do S := S + St2[i] ; S := S + St1 ; For i := Vt To length(St2) Do S := S + St2[i] ; St2 := S ; End ; End ; Bài : Viết chương trình thực các công việc sau : _ Lập thủ tục nhập ba số thực dương a , b , c từ bàn phím _ Lập thủ tục kiểm tra xem ba số trên có lập thành ba cạnh tam giác hay không ? _ Viết thủ tục tính diện tích tam giác _ Viết thủ tục tính các trung tuyến tam giác _ Viết hoàn thiện chương trình chính GIẢ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 (* bắt đầu thủ tục nhập *) Input(a, 'a'); Input(b, 'b'); Input(c, 'c'); End; (* kết thúc thủ tục nhập *) (*================================*) Procedure Kiemtra(a, b, c: Real); Begin If (a<b+c) and (b<a+c) and (c<a+b) then Writeln(a:0:2, ', ', b:0:2, ' va ', c:0:2, ' lap ba canh cua tam giac ') Else Writeln('Khong lap ba canh cua tam giac') ; End; (*===============================*) Procedure Trung_tuyen (a, b, c: Real); Var ma, mb, mc: real; Begin ma:=sqrt((2*sqr(b)+2*sqr(c)-sqr(a))/4); mb:=sqrt((2*sqr(a)+2*sqr(c)-sqr(b))/4); mc:=sqrt((2*sqr(a)+2*sqr(b)-sqr(c))/4); Writeln('Cac trung tuyen cua tam giac la : ') ; Writeln('ma=', ma:0:2, ' mb=', mb:0:2, ' mc=', mc:0:2); End; (*================================*) Procedure Dientich (a, b, c: real); Var p, S: real; Begin p:=(a+b+c)/2; S:=sqrt(p*(p-a)*(p-b)*(p-c)); Writeln('Dien tich =', S:0:2); End; (*================================*) BEGIN (* Chương trình chính *) Clrscr; Nhap(a, b, c); Kiemtra(a, b, c); Dientich(a, b, c); Trung_tuyen(a, b, c); Readln; END Bài :Giải phương trình x + y + z = 12 phạm vi số nguyên không âm với điều kiện x < GIẢI Uses Crt; Var X, Y, Z: byte; Begin Clrscr; Writeln('Giai phuong trinh X+Y+Z=12 pham vi ' + 'so nguyen khong am voi dieu kien x<4'); For X:=0 to For Y:=0 to 12 For Z:=0 to 12 If (X+Y+Z=12) then Writeln(' x=',X,' y=',Y, 'z=',Z); Readln; End Bài : Cho trước các số N , a , b , c tự nhiên Giải phương trình sau phạm vi số nguyên không âm x + y + z = N với điều kiện x < a , y < b , z < c GIẢI Uses Crt; Var N, a, b, c, X, Y, Z, i: Integer; Begin Clrscr; Write(' N, a, b, c = '); Readln(N, a, b,c); If (a+b+c-3<N) then Begin Writeln('Phuong trinh vo nghiem'); Readln; Exit; End Else Begin Writeln('Phuong trinh co nghiem la:'); Writeln('x': 10, 'y': 10, 'z':10); i:=4; For X:=0 to (a-1) For Y:=0 to (b-1) For Z:=0 to (c-1) If (X+Y+Z=N) then Begin Writeln(x: 10, y: 10, z: 10); inc(i); If i=24 then Begin Write('Nhan Enter de tiep tuc '); Readln; i :=0; End; End ; End ; Write('Nhan Enter de ket thuc '); Readln; End Bài : Viết thủ tục Compare ( S1 , S2 : String ; Var Kq : String ) thực công việc sau : so sánh hai xâu S1 và S2 , tìm tất các kí tự có hai xâu trên Xâu Kq chứa tất các kí tự đó , kí tự nhớ lần GIẢ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; (* Kiểm tra xem kí tự Ch có xâu St không Nếu có thì hàm trả giá trị True Nếu không thì hàm trả giá trị False *) Begin kt:=pos(ch,st)<>0; End; (*================================*) Begin (* Thân thủ tục Compare*) kq:=''; (* Xâu rỗng *) For i:=1 to length(s1) If (not kt(s1[i],kq)) and (kt(s1[i],s2)) then kq:=concat(kq,s1[i]); End; (*==============================*) BEGIN Clrscr; Writeln('Nhap 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 ca hai xau '); Write('Nhan ENTER de ket thuc '); Readln; END Bài : Viết hàm tính D (St1 , St2) , với U, V là hai xâu kí tự bất kì , là tổng số các kí tự không giống hai xâu trên , loại kí tự nhớ lần Ví dụ D (‘aabba’ , ‘bcdd’) = vì có hai kí tự a và d là không giống các xâu trên GIẢ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; (*Trả tổng số loại kí tự không giống xâu U và V *) Var k, id: byte; s, luu: string; Begin luu:=''; (* Xâu rỗng *) For id:=1 to length(U) If (pos(U[id],V)=0) and (pos(U[id],luu)=0) then luu:=concat(luu,U[id]); For id:=1 to length(V) 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 Begin Write('S',i,'='); Readln(S[i]); End; End ; (*===============================*) BEGIN (* Chương trình chính *) Clrscr; nhap; max:=0; min:=255; For i:=1 to n-1 For j:=i+1 to n Begin If max<d(S[i],S[j]) then max:=d(S[i],S[j]); If min>d(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 Bài : Viết chương trình hoàn chỉnh thực các công việc thực đơn sau : 1 Nhập liệu ( nhập số tự nhiên n ) 2 Phân tích thừa số nguyên tố ( phân tích n thành tích các số nguyên tố ) 3 Thoát khỏi chương trình GIẢ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 ' + '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 Write(a[i],'*'); Writeln(a[dem]); End; End; (*================================*) 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 tich cua cac so nguyen to :'); nhap(N); phantich(N); Write('Nhan Enter de ket thuc '); Readln; END BÀI TẬP CHƯƠNG 5: XÂU KÝ TỰ Bài : Lập trình đếm số lần xuất loại kí tự thuộc bảng chữ cái tiếng Anh xâ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' A[ch]:=0; For i:=1 to length(s) 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' Writeln('So lan xuat hien cua ',ch,' xau la: ', A[ch]:4) ; Readln ; END Bài : Cho số tự nhiên n và xâu có độ dài n Hãy biến đổi xâu đã cho cách thay đổi đó : a a Tất các dấu ! dấu chấm b b Mỗi nhóm các dấu chấm liền dấu chấm c c Một nhóm các dấu chấm đứng liền dấu ba chấm a) Var S: string; i: byte; BEGIN Write(' Cho mot xau ki tu S = '); Readln(S); For i:=1 to length(S) If S[i] = '!' then S[i]:= '.'; Write( ' Chuoi sau da bien doi la : ', S); Readln; END b) Uses crt; Var S : string; i : byte; BEGIN Clrscr; Write(' Cho mot xau ki tu S = '); Readln(S); i:=1; While i< length(S) If (S[i]='.')and(S[i+1]='.') then Delete(S,i,1) Else inc(i); Write('Chuoi sau 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) Begin If S[i]='.' then Begin j:=i; While (S[i]='.')and(i<=length(S)) 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 bien doi la: ',S); Readln; END Bài : Cho số tự nhiên n và dãy các kí tự S1 , S2 , … , Sn Hãy tìm số tự nhiên I đầu tiên cho các kí tự Si , Si+1 là chữ cái a Nếu dãy không có cặp thì thông báo Var S: string; i: integer; BEGIN Write(' Cho mot xau ki tu : '); Readln(S); i:= pos('aa', S); {tìm vị trí xâu 'aa' S} If i<>0 then Writeln(' Ton tai "aa" tai vi tri ', i) Else Writeln(' Khong ton tai ') ; Readln; END Bài : Cho số tự nhiên n và dãy các kí tự S1 , S2 , … , Sn Biết dãy có ít dấu phẩy Hãy tìm số tự nhiên i cho : a a Si là dấu phẩy đầu tiên b b Si là dấu phầy cuối cùng a) Var S: string; i: integer; BEGIN Write('Cho mot xau S co dau ",": '); Readln(S); i:= pos(',', S); (* vị trí dấu ',' S *) If i<> 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] <> ',' ) i:=i -1; If i>=1 then Write('So thu tu thoa man la: ', i) Else Write('Khong ton tai.'); Readln; END Bài : Viết chương trình nhập xâu kí tự , sau đó xem xâu đó có phải là xâu đối xứng không ( xâu đối xứng là xâu có các kí tự giống và đối xứng qua điểm xâu , ví dụ ‘ABBA’ ‘ABCBA’ ) Uses Crt; Var St : string; dx : Boolean; 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)) 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 Bài : Cho xâu kí tự S Hãy viết chương trình tính xem S có bao nhiêu loại kí tự khác ( phân biệt chữ in hoa với chữ in thường ) Ví dụ với S là “Pascal” ta có đáp số là 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) Begin t:=false; For j:=1 to i-1 if (S[j]=S[i]) then t:=true; If not t then dem:= dem+1; End; Write('So ki tu khac cua xau S la: ', Dem); Readln; END Bài : Viết chương trình nhập xâu kí tự và biến đổi chúng thành toàn chữ in hoa Var S : string; i : integer; BEGIN Write('Cho mot xau ky tu: '); Readln(S); For i:=1 to length(S) If S[i] in ['a' 'z'] then S[i]:= Upcase(S[i]); Write('Chuoi sau da bien doi la: ', S); Readln; END Bài : Họ tên học sinh nhập từ bàn phím Bạn hãy viết chương trình điều chỉnh lại các kí tự đầu các từ đơn tên học sinh trở thà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 If (Hoten[i-1]=#32)and(Hoten[i] in Chu) then Hoten[i]:=Upcase(Hoten[i]); Write('Ho ten sau dieu chinh la: ', Hoten); Readln; END Bài : Viết chương trình nhập xãu kí tự từ bàn phím , sau đó gọt xâu lại cách cách xoá các kí tự trống hai đầu xâu Ví dụ nhập xâu “ Ha noi “ , thì kết là “Ha Noi” ar S: String; BEGIN Write('Cho mot xau ky tu: '); Readln(S); While S[1] = #32 Delete(S,1,1); While (S[length(S)] = #32) Delete(S,length(S),1); Write('Chuoi sau da bien doi la: ', S); Readln; END BÀI TẬP CHƯƠNG 6: DỮ LIỆU KIỂU TẬP Bài : Bạn hãy viết hàm Card(A) đếm số phần tử tập hợp A cho trước có kiểu Set Of 99 (* hàm đếm số phần tử tập hợp *) Uses Crt; Type Tap=set of 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) 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 If i in S then Inc(n); Card:=n; End; BEGIN Nhap; Clrscr; Write('Tap S co ',Card(S),' phan tu.'); Readln; END Bài : Bạn hãy lập chương trình tạo tập hợp các số nguyên chẵn kiểu Byte và loại khỏi nó các số chia hết cho Kết thể trên màn hình Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 99; 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 Read(f,ds[i]); Close(f); For i:=1 to n-1 For j:=i+1 to n 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 With ds[i] Writeln(holot:20,ten:11,tuoi:4,lop:5); Writeln; Write('Bam Enter de ket thuc '); Readln; END Bài : Xét chương trình sau : Program B4 ; Var Thoat : Set Of Char = [‘e’ , ’E’] ; BEGIN Write (‘ Hay go E de ket thuc : ‘) ; Repeat Ch := Readkey ; Until Ch in thoat ; END Hãy tìm và sửa lỗi chương trình đó 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 Bài : Bạn hãy lập chương trình hiển thị menu dạng sau trên màn hình Xem 2 Sua chua 3 Loai bo 4 Nhap them 5 Thoat Lua chon cua ban : _ Sau đó đợi gõ phím Chương trình phải đợi phím gõ vào là các chữ số các chữ cái đầu các tuỳ chọn thì thông báo phím gõ vào hợp lệ và kết thúc chương trình Trong chương trình phải dùng tập hợp để kiểm tra việc nhập giá trị cho biến từ bàn phím (* Hiển thị menu *) Uses Crt; Const menu: set of char = ['1' '5','X','S','L','N','T']; Var ch: char; BEGIN Clrscr; Writeln(' Xem '); Writeln(' Sua chua '); Writeln(' Loai bo '); Writeln(' Nhap them'); Writeln(' Thoat '); 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(' Xem '); '2','S': Writeln(' Sua chua '); '3','L': Writeln(' Loai bo '); '4','N': Writeln(' Nhap them'); '5','T': Writeln(' Thoat '); End; Readln; END Bài : Hãy lập chương trình nhập vào xâu nhị phân Các kí tự nhập vào không hợp lệ bị bỏ qua (* nhập xâu nhị phâ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 Bài : Hãy lập chương trình nhập vào xâu kí tự từ bàn phím Yêu cầu các kí tự nhập vào phải là các chữ cái thuộc bảng chữ cái tiếng Anh , bỏ qua các phím khác (* Nhập xâu toàn các chữ cái *) Uses Crt; Const A:set of char=['a' 'z','A' 'Z']; Var ch: char; 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 Bài : Viết chương trình có chức thêm phần tử vào tập hợp trực tiếp từ bàn phím và loại bớt phần tử khỏi tập hợp trực tiếp từ bà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' 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 lai cua tap hop la:'); For ch:='a' to 'z' If ch in tap then Write(ch,' '); Readln; END BÀI TẬP CHƯƠNG 7: KIỂU RECORD Bài : Thông tin học sinh gồm :   Họ đệm : xâu 25 kí tự   Tên : xâu 10 kí tự   Tuổi : số nguyên hai chữ số   Lớp : xâu hai chữ số và chữ cái viết hoa Hãy lập chương trình nhập từ bàn phím danh sách lớp 15 học sinh vào mảng ghi Sau đó hiển thị danh sách lên màn hình , người dòng (* Nhập danh sách học sinh từ bàn phím *) Uses Crt; Const n=15; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 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 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 With ds[i] Writeln(holot:20,ten:10,tuoi:4,lop:5); Writeln; Write('Bam Enter de ket thuc '); Readln; END Bài : Thông tin học sinh là ghi gồm các trường :   Họđệm : xâu 25 kí tự   Tên : xâu 10 kí tự   Tuổi : số nguyên hai chữ số   Lớp : xâu hai chữ số và chữ cái viết hoa Một file ghi chứa danh sách lớp gồm 20 học sinh Hãy lập chương trình hiển thị danh sách lên màn hình , người dòng (* Doc tu mot file ban ghi *) Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 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 Begin Read(f,ds); With ds Writeln(holot:20,ten:11,tuoi:4,lop:5); End; Close(f); Writeln; Write('Bam Enter de ket thuc '); Readln; END Bài : Một file ghi chứa danh sách học sinh , thông tin học sinh giống bài trên Hãy lập chương trình tạo file ghi khác chứa danh sách đó , ghi gồm các trường :   Họtên : xâu 35 kí tự   Tuổi : số nguyên hai chữ số   Khối : số nguyên hai chữ số   Lớp : chữ cái viết hoa (* Doi kieu ban ghi *) Uses Crt; Type Danhsach1=record holot: string[25]; ten: string[10]; tuoi: 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; 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) Begin Read(f1,ds1); With ds1 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; END Bài : Một file ghi chứa danh sách học sinh PTTH , thông tin học sinh ngoài các trường Họđệm , Tên , Tuổi , Lớp giống các bài trên còn có thêm trường Điểm chứa điểm trung bình học sinh năm học Hãy lập chương trình : a a Hiển thị lên màn hình danh sách học sinh giỏi trường là bạn có điểm trung bình từ 8.0 trở lên và cao khối b b Lập danh sách học sinh năm học , biết học sinh có điểm trung bình từ 5.0 trở lên thì lên lớp Chú ý : lớp 10A lên lớp 11A , lớp 11A lên 12A Kết chứa file (* Khen thuong va len lop *) Uses Crt; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 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) 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 With ds[i] 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 With ds[i] 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 With ds[i] 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 With ds[i] 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 With ds[i] 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 With ds[i] If lop<>'DTN' then Write(f,ds[i]); Close(f); End; BEGIN ClrScr; Nhap; Timgioi; Lenlop; Write('Bam ENTER de ket thuc '); Readln; END Bài : Cho file ghi f chứa liệu kho sách , liệu sách chứa ghi gồm trường mang thông tin :   Họ tên tác giả : xâu 26 kí tự   Tên sách : xâu 40 kí tự   Năm xuất : số nguyên chữ số Hăy lập chương trình nhập liệu vào kho sách , sau đó tìm :   Những sách tác giả cho trước xuất vào năm cho trước   Những sách có tên cho trước Kết trên mà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) 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)) 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 TheoTS; Var ten: string; i: integer; Begin Write('Cho ten sach : '); Readln(ten); i:=1; While (i<=n)and(ds[i].tensach<>ten) 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 Bài : File ghi F chứa danh sách các ngày lễ năm , ghi gồm ngày tháng , tên ngày lễ và số ngày nghỉ Hãy lập chương trình nhập danh sách các ngày lễ và tính :   Tổng số các ngày lễ và tổng số các ngày nghỉ lễ năm   Tổng số các ngày lễ và tổng số các ngày nghỉ lễ quí , quí , … Kết thể trên màn hình (* Tinh so le va nghi nam ,qui *) Uses Crt; 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) 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 With ds[i] 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); End ; If (thang<12) then Begin Inc(snnq4,songay); Inc(tsq4); End; End; End; Procedure Inkq; Var i: integer; Begin Writeln('So le nam : ',n); Writeln('Tong so nghi le nam : ',snn); Writeln; Writeln('So le qui : ',tsq1); Writeln('Tong so nghi le qui : ',snnq1); Writeln('So le qui : ',tsq2); Writeln('Tong so nghi le qui : ',snnq2); Writeln('So le qui : ',tsq3); Writeln('Tong so nghi le qui : ',snnq3); Writeln('So le qui : ',tsq4); Writeln('Tong so nghi le qui : ',snnq4); Writeln; End; BEGIN Clrscr; Nhap; Tinh_ngay_nghi; Inkq; Write('Ban Enter de ket thuc '); Readln; END BÀI TẬP CHƯƠNG 8: KIỂU FILE Bài : Hãy lập chương trình tạo tệp số nguyên chứa các số nguyên tố nhỏ 10000 theo thứ tự tăng dần (* Tạo file số nguyên tố nhỏ 10000 *) Uses Crt; Const N=10000; Var i , j : Integer; f: File of Integer; a: Array[2 N] of boolean; BEGIN For i:=2 to N a[i]:=true; i:=2; Repeat For j:=2 to (N div i) 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 If a[i] then Write(F,i); Close(F); clrscr; Write(' Viet file "C:\SoNT" cac so nguyen to nho hon 10000 '); Readln; END Bài : Cho f là tệp văn chứa các xâu 10 kí tự Hãy lập chương trình nhập và hiển thị nội dung file đó lên màn hình , xâu dòng , đầy trang màn hình thì dừng lại đợi gõ Enter hiển thị trang hết (* Ghi và đọ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 S='''' (go Enter)!'); Readln(S); While (S<>'') 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 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 Bài : Bạn hãy viết chương trình cho phép đọc liệu từ bàn phím và ghi thêm vào cuối tệp các ghi (* Doc và ghi vào cuối tệp các 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 Bài : Cho văn chứa text file f Trong văn , tính từ trái sang phải , từ trên xuống , kí tự # là kí hiệu xoá từ đứng trước nó có Ví dụ ‘#Ta#oi di ngu#h###hoc’ có nghĩa là ‘Toi di hoc’ Bạn hãy viết chương trình sửa lại file f theo quy ước trên (* Sửa văn *) 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) 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 sua chua :') ; docfile(fi) ; Readln; END Bài : Cho file f và g cùng kiểu ( không rõ kiểu nào ) Bạn hãy lập thủ tục gán nội dung file g cho file f (* Gan hai file *) Uses Crt; 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 Bài : Cho file text ghi lại chương trình Pascal học sinh Hãy viết chương trình kiểm tra lỗi chương trình Pascal trên theo các cách sau đây : Cách : Kiểm tra xem số lượng các dấu ‘ ( dấu mở và dấu đóng ) có không ? Cách : Kiểm tra xem số lượng các từ Begin và End có không ? (* Dem (') và '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) Begin Readln(f,S); While pos(c,s)<>0 Begin Inc(n); Delete(s,pos(c,s),l); End; End; 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 Bài : Cho file text Hãy viết chương trình đếm xem file text trên chứa bao nhiêu từ ( Chú ý : theo quy định , các từ cách hay nhiều dấu cách ) (* Đế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) Begin Readln(f,s); While s[1]=' ' Delete(s,1,1); While length(s)>0 Begin Case s[1] of ' ': While (s[1]=' ')and(length(s)>0) Delete(s,1,1); Else Begin inc(dem); While (s[1]<>' ')and(length(s)>0) Delete(s,1,1); End; End; End; End; Close(f); Write(' So tu co file hoten.txt la: ',dem); Readln; END Bài : Cho file text Viết chương trình loại bỏ các khoảng trống thừa bên file text này (* Cat khoang 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) Begin Readln(inp,s); While (s[1]=' ')and(Length(s)>0) Delete(s,1,1); While (s[Length(s)]=' ')and(Length(s)>0) Delete(s,Length(s),1); While (Length(s)>0)and(pos(' ',s)<>0) Delete(s,pos(' ',s),1); Writeln(out,s); End; Close(out); Close(inp); END BÀI TẬP CHƯƠNG 9: CON TRỎ Bài : Bạn hãy lập chương trình cho phép ta nhập từ bàn phím danh sách ghép nối Sau đó gỡ bỏ record khỏi danh sách (* Gỡ bỏ ghi khỏi danh sách *) Uses Crt; Type ptr=^rec; rec=record name: string[20]; next: ptr; End; Var k : integer; p,l : ptr; Procedure Nhap; Begin 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 p:=p^.next; q:=p; p:=l; For i:=3 to k p:=p^.next; If k=1 then l:=q Else p^.next:=q; End; (* Tìm vị trí cuối *) (* Tìm vị trí đầu *) Procedure In_kq; Begin While (l^.next<>nil) Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Gobo; In_kq; END Bài : Bạn hãy lập chương trình cho phép nhập danh sách ghép nối Sau đó chèn thêm record vào danh sách (* Chèn thêm ghi vào danh sách *) Uses Crt; Const inp='C9_2.inp'; Type ptr=^rec; 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) 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 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) Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Chen_rec; In_kq; END Bài : Bạn hãy lập chương trình cho phép nhập danh sách ghép nối Sau đó đổi chỗ hai record danh sách (* Đổi chỗ ghi danh sá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) Begin Readln(f,p^.name); New(p^.next); p:=p^.next; End; p^.next:=nil; Close(f); Clrscr; Write('Nhap vi tri ban ghi can doi cho: '); Readln(j,k); End; Procedure Doicho; Var i: integer; Begin p:=l; For i:=2 to k p:=p^.next; tenk:=p^.name; p:=l; For i:=2 to j p:=p^.next; tenj:=p^.name; p:=l; For i:=2 to k p:=p^.next; p^.name:=tenj; p:=l; For i:=2 to j p:=p^.next; p^.name:=tenk; End; Procedure In_kq; Begin While (l^.next<>nil) Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Doicho; In_kq; END BÀI TẬP CHƯƠNG 10: ĐỒ HỌA Bài : Vẽ hình chữ nhật có tâm trùng với tâm màn hình , các cạnh song song và tỉ lê với các cạnh màn hình , kích thước lớn dần theo thời gian (* Hình chữ nhật thay đổ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 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 Bài : Vẽ hình chữ nhật trên , kích thước điều khiển Nếu gõ phím + thì hình lớn lên , gõ phím – thì nhỏ , gõ Enter thì dừng chương trình (* Hình chữ nhật kích thước điều khiển *) 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(x<GetMaxX) then Inc(x) Else If (c='-')and(y>0) 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); Until c=#27; CloseGraph; END Bài : Một bàn cờ vua hiển thị trên màn hình Nếu đặt hậu ( hình tròn màu đỏ ) vào ô cách nhập tên ô , chẳng hạn a5 , thì các ô bị hâu khống chế tô màu xanh Bạn hãy lập chương trình thực các yêu cầu trên (* Phạm vi kiểm soát Con hậ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 For j:='a' to chr(Ord('a')+N-1) 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 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 For j:='a' to chr(Ord('a')+N-1) 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); Readln; CloseGraph; END Bài : Vẽ đồng hồ điện tử hoạt động trên màn hình (* Đồng hồ điệ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 Bài : Hiển thị điểm chuyển động theo chiều kim đồng hồ trên quỹ đạo tròn , tâm là tâm màn hình , bán kính r = 150 (* Điểm chuyển động tròn *) Uses Crt, Graph; Const r=150; v=5; Var Gd,Gm,x0,y0,x,y: Integer; a: real; (* gó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 Bài : Hiển thị hình chữ nhật trên màn hình , vị trí có thể điều khiển bàn phím Gõ các phím mũi tên để dịch chuyển hình đó theo cá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^); 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 Bài : Vẽ hình sau với các phông chữ , các màu khác : Size Size 16 Size 24 Size 32 Size 40 (* Các dạng phông chữ *) 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 Begin ClearDevice; For i:=1 to 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 Bài : Vẽ hệ trục toạ độ và đồ thị hàm số y = x2 với đầy đủ chú thích (* Đồ thị hàm số 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 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 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 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 Bài : Vẽ và tô màu cho ngôi nhà sau Đảm bảo khả bật tắt điện cho ngôi nhà Nếu gõ phím + thì đèn sáng ( cửa sổ có màu trắng ) , gõ phím – thì đèn tắt ( cửa số có màu đen ) (* To mau Ngoi nha *) Uses Crt,Graph; Var Gd,Gm: Integer; Pattern : FillPatternType; c: Char; 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 MỤC LỤC Chương 1:IF …… Then …………Else