bài tập Pascal hay(có đáp án)

BÀI TẬP CƠ BẢN
Bài tập chương 1: CÚ LỆNH IF ….THEN…
* Bài 1 : Nhập ba số a,b,c bất kì . Hãy kiểm tra xem ba số nó có thể là độ dài của 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 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 .
* BÀI 2 : Nhập N số bất kì
Nếu các số lớn hơn 10 và nhỏ hơn 20 thì tính tổng của chúng . Sau đó, in ra 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 := 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 ;
End ;
Writeln (' So cac so >10 va <20 la : ', Dem ) ;
Writeln (' Tong cua chung la :', Tong ) ;
Readln ; END .
* Bài 3 : Nhập 4 số a , b , c , d . Hãy tìm giá trị lớn nhất của chúng và gán gi trị lớn nhất cho biến Max .
GIẢ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 ;
GV : Võ Thị Sen
1
BÀI TẬP CƠ BẢN
END .
* Bài 4 : Nêu ngày tháng năm, sau đó viết ra màn hình các thứ trong 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 < 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 ') ;
2 : Writeln (' Thu Ba ') ;
3 : Writeln (' Thu Tu ') ;
4 : Writeln (' Thu Nam ') ;
5 : Writeln (' Thu Sau ') ;
6 : Writeln (' Thu Bay ') ;
End ;
Readln ;
END .
* Bài 5 :Viết chương trình :
Nhập số báo danh
Nhập điểm văn, toán, ngoại ngữ
In ra màn hình dưới 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 ( hoặc 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 ) ;
GV : Võ Thị Sen
2
BÀI TẬP CƠ BẢN
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 6 :Viết chương trình nhập hai số thực . Sau đó hỏi phép tính cần thực hiện và in kết quả của phép tính
đó .

Nếu là “+” , in kết quả của tổng lên màn hình .
Nếu là “-” , in kết quả của hiệu lên màn hình .
Nếu là “/” , in kết quả của thương lên màn hình .
Nếu là “*” , in kết quả của tích lên màn hình . Nếu là “+” , in kết quả của tổng lên màn hình .
Nếu là “+” , in kết quả của 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 7 : Viết chương trình nhập hai số tự nhiên N, M và thông báo ‘Dung‘ nếu N , M cùng tính chẵn lẽ ,
trong 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 2 = 0 ) 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 1 :
Lập trình tính tích các số tự nhiên từ 1 tới 10 .
GIẢI
Var i : Byte ; (* chỉ số chạy *)
p : word ; (* tích số *)
BEGIN
GV : Võ Thị Sen
3
BÀI TẬP CƠ BẢN
p := 1;(* cho giá trị ban đầu của tích *)
For i := 1 to 10 Do (* cho i chạy từ 1 tới 10 *)
p := p * i ; (* lần lượt nhân i với p *)
Write (' 1 * 2 * * 10 = ', p ) ;
Readln ; END .
Bài 2 :Viết chương trình đếm số lần xuất hiện của các kí tự thuộc bảng chữ cái trong 50 lần gõ kí tự
bằng 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 bộ đếm *)
ch : char ; (* biến nhập kí tự *)
i : byte ; (* chỉ số của lần gõ phím *)
BEGIN
Clrscr ;
For ch :='A' to 'Z' Do a[ch] := 0 ; (* xả bộ đếm *)
Writeln (' Go phim 50 lan ') ;

For i := 1 To 50 Do (* thực hiện 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] + 1 ;
End;
Writeln (' So lan xuat hien cac ki tu la :') ;
For ch :='A' to 'Z' do (* Kiểm tra bộ đếm từ 'A' tới 'Z' *)
If a[ch] > 0 Then (* Nếu Ch có xuất hiện *)
Writeln (ch , a[ch] : 4 , ' lan . ') ; (* Viết ra màn hình kí tự và
số lần xuất hiện *)
Readln ; END .
* Bài 3 :Cho số tự nhiên n , hãy lập trình để tính các tổng sau :
a. a. 1 + 1/2
2
+ 1/3
2
+ … + 1/n
2

b. b. 1 + 1/2! + 1/3! + … + 1/n!
GIẢI
a)
Var n , i : Word ;
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
GV : Võ Thị Sen
4
BÀI TẬP CƠ BẢN
p := p * i ; (* tính i *)
S := S + 1 / p ;
End ;
Writeln (' S = ', S:0:2) ;
Readln ; END .
*Bài 4 : Tính giá trị của biểu thức sau :
( 1 + 1/1
2
) ( 1 + 1/2
2
) … ( 1 + 1/n
2
)
GIẢ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ử dụng lệnh While
* Bài 5 : Lập trình tính tổng :
A = 1 + 1/2 + 1/3 + … + 1/n (ở đây n là số tự nhiên được 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 + 1 ;
End ;
Writeln (' Tong can tim la : ', tong:12:6 ) ;
Readln ; END .
* Bài 6 : Tính hàm lũy thừa a
n
, ở đây a thực và n tự nhiên được 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 := 1 ;
giatri := 1 ;
While i <= n Do
Begin
giatri := giatri * a ;
i:= i+1 ;
End ;
Writeln(' a mu n bang : ', giatri ) ;
GV : Võ Thị Sen
5
BÀI TẬP CƠ BẢN
Readln ; END .
* Bài 7 : Viết chương trình nhập một dãy số tối đa 100 số , sau đó in ra màn hình các số khác nhau .
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 := 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 .
* Bài 8 : Viết chương trình nhập một dãy số tối đa 100 số , sau đó sắp 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 := 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 ;
End ;
j := j + 1;
GV : Võ Thị Sen
6
BÀI TẬP CƠ BẢN
End ;
i := i + 1;
End ;
Writeln(' Day sau khi sap xep : ') ;
For i := 1 To N Do Write(A[i] : 4) ;
Readln ; END .
Sử dụng lệnh Repeat
* Bài 9 : Cho một dãy số được nhập từ bàn phím . Hãy viết chương trình nhập một số a rồi liệt kê tất cả các
phần tử trong dãy lớn hơn a.
GIẢ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 .
* Bài 10 : Bạn có 1000 đ đem gửi ngân hàng với lãi suất 8%/tháng . Sau mỗi tháng tiền lãi được nhập vào
để tính lãi suất tháng sau . Bạn muốn để dành cho đến khi số tiền tăng lên là x . Vậy phải để trong 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 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 .') ;

GV : Võ Thị Sen
7
BÀI TẬP CƠ BẢN
writeln (' Khi do so tien ban rut ra duoc la ', tien:12:2 ,' dong .') ;
readln ; END .
* Bài 11 : Viết chương trình tìm ƯSCLN của N số được 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 := 1 To n Do
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 .
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 ra một mảng chứa bả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) ;
(* hết 80 cột tự động xuống hàng *)
Readln ;
END .
Bài 3 : 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 2 so nguyen duong m, n :') ;
Write (' m = ') ; Readln(m) ;
Write (' n = ') ; Readln(n);
If m > n Then (* đỗi chỗ để m <= n *)
Begin
GV : Võ Thị Sen
8
BÀI TẬP CƠ BẢN
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 .
Bài 4 : Viết chương trình nhập từ bàn phím các phần tử của một mảng hai chiều . Kích thước của mảng
được nhập trước từ bà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]) ;
End ;
Readln ;
END .
Bài 5 :
Dãy số sau được gọi là dãy Fibonaci :
a
1
= 1
a
2

= 1
a
3
= 2
a
4
= 3
. . .
a
n
= a
n-1
+ a
n-2

Viết chương trình tính 20 số Fibonaci đầu tiên và đưa ra kết quả vào một 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 do a[i]:=a[i-1]+a[i-2] ;
END .
Bài 6: Dãy số a
n
được định nghĩa như sau :
a
1
= 1

a
2
= 2
. . .
a
n
= 2a
n-1
+ a
n-2
( n > 2 )
Hãy lập chương trình tính và gán giá trị của dãy vào biến mảng .
Var a : Array [1 100] Of Word ;
i, N : Byte ;
S : Real ;
GV : Võ Thị Sen
9
BÀI TẬP CƠ BẢN
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] ;
S := 0 ;
For i := 1 to N do S := S+1/sqr(a[i]) ;
Writeln (' S = ', S:12:6) ;
Readln ;
END .
Bài 8 : a.Viết chương trình nhập dữ liệu từ dãy đối xứng vào mảng một chiều
b. Viết chương trình nhập dữ 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 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
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 ;

GV : Võ Thị Sen
10
BÀI TẬP CƠ BẢN
BÀI TẬP CHƯƠNG 4: CHƯƠNG TRÌNH CON
Bài 1 :
Dùng thủ tục chuyển một số tự nhiên n cho trước sang hệ cơ số 2 .
GIẢI
Procedure Change ( n : integer ; Var St : String ) ;
(* thủ tục chuyển số tự nhiên n cho trước sang
hệ cơ số 2 và được lưu ở trong 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 2 ;
So :=So div 2 ;
S := b[du] + s ;
Until So = 0 ;
St := S ; End ;
Bài 2 :Dùng thủ tục giải phương trình bậc hai ax
2
+ bx + c = 0
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 2 nghiem phan biet la :');
Writeln('X1=',x1:8:2, 'X2=',x2:8:2);
End;
End;
GV : Võ Thị Sen
11
BÀI TẬP CƠ BẢN

(*================================*)
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 3 :
Hãy viết lại thủ tục Insert đối với một 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 bắt đầ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 := '' ; (* xâu rỗ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 ;
End ;
End ;
Bài 4 :
Viết chương trình thực hiện lần lượt 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 của tam giác hay không ?
_ Viết thủ tục tính diện tích của tam giác .
_ Viết thủ tục tính các trung tuyến của 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);
GV : Võ Thị Sen
12
BÀI TẬP CƠ BẢN
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 thanh ba canh cua tam giac ')
Else Writeln('Khong lap thanh 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 5 :Giải phương trình x + y + z = 12 trong phạm vi số nguyên không âm với điều kiện x < 4 .
GIẢI
Uses Crt;

Var X, Y, Z: byte;
Begin
Clrscr;
Writeln('Giai phuong trinh X+Y+Z=12 trong pham vi '
+ 'so nguyen khong am voi dieu kien x<4');
For X:=0 to 3 do
For Y:=0 to 12 do
For Z:=0 to 12 do
If (X+Y+Z=12) then Writeln(' x=',X,' y=',Y, 'z=',Z);
Readln;
End.
Bài 6 :
Cho trước các số N , a , b , c tự nhiên . Giải phương trình sau trong 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;
GV : Võ Thị Sen
13
BÀI TẬP CƠ BẢN
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) do
For Y:=0 to (b-1) do
For Z:=0 to (c-1) do
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 7 :
Viết thủ tục Compare ( S1 , S2 : String ; Var Kq : String ) thực hiện công việc sau : so sánh hai xâu S1
và S2 , tìm tất cả các kí tự có trong cả hai xâu trên . Xâu Kq sẽ chứa tất cả các kí tự đó , mỗi kí tự chỉ
được nhớ một 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ó trong xâu St không . Nếu có thì
hàm trả về giá trị True . Nếu không thì hàm trả về giá trị False *)
Begin
kt:=pos(ch,st)<>0;
End;
(*================================*)
Begin (* Thân của thủ tục Compare*)
kq:=''; (* Xâu rỗng *)
For i:=1 to length(s1) do
GV : Võ Thị Sen
14
BÀI TẬP CƠ BẢN
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 .
Bài 8 :

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 nhau trong
hai xâu trên , mỗi loại kí tự chỉ được nhớ một lần . Ví dụ D (‘aabba’ , ‘bcdd’) = 2 vì chỉ có hai kí tự a và
d là không giống nhau trong 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ả về tổng số loại kí tự không giống nhau
trong 2 xâu U và V *)
Var k, id: byte;
s, luu: string;
Begin
luu:=''; (* Xâu rỗ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
GV : Võ Thị Sen
15
BÀI TẬP CƠ BẢ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 do
For j:=i+1 to n do
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 9 :
Viết chương trình hoàn chỉnh thực hiện các công việc của thực đơn sau :
1. 1. Nhập dữ liệu ( nhập số tự nhiên n ) .

2. 2. Phân tích ra thừa số nguyên tố ( phân tích n thành tích các số nguyên tố ) .
3. 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 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;

GV : Võ Thị Sen
16
BÀI TẬP CƠ BẢN
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 thanh 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 1 :
Lập trình đếm số lần xuất hiện ở mỗi loại kí tự thuộc bảng chữ cái tiếng Anh trong một 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' 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
Writeln('So lan xuat hien cua ',ch,' trong xau la: ', A[ch]:4) ;
GV : Võ Thị Sen
17
BÀI TẬP CƠ BẢN
Readln ;
END .
Bài 2 :
Cho số tự nhiên n và xâu có độ dài n . Hãy biến đổi xâu đã cho bằng cách thay đổi trong đó :

a. a. Tất cả các dấu ! bằng dấu chấm .
b. b. Mỗi một nhóm các dấu chấm liền nhau bằng một dấu chấm .
c. c. Một nhóm các dấu chấm đứng liền nhau bằng 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) 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
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
j:=i;
While (S[i]='.')and(i<=length(S)) do inc(i);
dec(i);
If (i-j)=1 then insert('.',S,i)
GV : Võ Thị Sen
18
BÀI TẬP CƠ BẢN
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 .
Bài 3 :

Cho số tự nhiên n và một dãy các kí tự S
1
, S
2
, … , S
n
. Hãy tìm số tự nhiên I đầu tiên sao cho các kí tự
S
i
, S
i+1
đều là chữ cái a . Nếu trong dãy không có những cặp như vậy 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 con 'aa' trong S}
If i<>0 then Writeln(' Ton tai "aa" tai vi tri ', i)
Else Writeln(' Khong ton tai .') ;
Readln;
END .
Bài 4 :
Cho số tự nhiên n và dãy các kí tự S
1
, S
2
, … , S
n
. Biết rằng trong dãy có ít nhất một dấu phẩy . Hãy tìm
số tự nhiên i sao cho :

a. a. S
i
là dấu phẩy đầu tiên .
b. b. S
i
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í của dấ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 .
GV : Võ Thị Sen
19
BÀI TẬP CƠ BẢN
Bài 5 :

Viết chương trình nhập một xâu kí tự , sau đó chỉ ra 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 nhau và đối xứng nhau qua điểm giữa xâu , ví dụ ‘ABBA’ hoặc
‘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)) 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 .
Bài 6 :
Cho một xâu kí tự S . Hãy viết chương trình tính xem trong S có bao nhiêu loại kí tự khác nhau ( 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à 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 .
Bài 7 :
Viết chương trình nhập một 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);
GV : Võ Thị Sen
20
BÀI TẬP CƠ BẢN
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 .
Bài 8 :
Họ tên một học sinh được 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ủa
các từ đơn trong tên của học sinh ấy 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 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 .
Bài 9 :
Viết chương trình nhập xãu kí tự từ bàn phím , sau đó gọt xâu lại bằng cách cách xoá đi các kí tự trống ở
hai đầu của xâu . Ví dụ nếu nhập xâu “ Ha noi “ , thì kết quả sẽ là “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 .
BÀI TẬP CHƯƠNG 6: DỮ LIỆU KIỂU TẬP


Bài 1 :
Bạn hãy viết hàm Card(A) đếm số phần tử của tập hợp A cho trước có kiểu Set Of 0 99 .
(* hàm đếm số phần tử của tập hợp *)
Uses Crt;

Type Tap=set of 0 99;
Const inp='Number.dat';
Var S : Tap;
i : byte;
Procedure Nhap;
Var a: byte; f: text;
Begin
S:=[];
GV : Võ Thị Sen
21
BÀI TẬP CƠ BẢN
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.
Bài 2 :
Bạn hãy lập chương trình tạo một 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 3 . Kết quả thể hiện trên màn hình .
Uses Crt;
Const n=5;
Type
Danhsach=record
holot: string[25];
ten: string[10];
tuoi: 0 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);
GV : Võ Thị Sen
22

BÀI TẬP CƠ BẢN
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.
Bài 3 :
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 trong 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 4 :
Bạn hãy lập chương trình hiển thị một menu dạng sau trên màn hình
1. Xem
2. 2. Sua chua
3. 3. Loai bo
4. 4. Nhap them
5. 5. Thoat
Lua chon cua ban : _
GV : Võ Thị Sen
23
BÀI TẬP CƠ BẢN
Sau đó đợi gõ phím . Chương trình phải đợi cho tới khi phím gõ vào là một trong các chữ số 1 5 hoặc
các chữ cái đầu của 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 một 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(' 1. Xem ');
Writeln(' 2. Sua chua ');
Writeln(' 3. Loai bo ');
Writeln(' 4. Nhap them');
Writeln(' 5. 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(' 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.
Bài 5 :
Hãy lập chương trình nhập vào một xâu nhị phân . Các kí tự nhập vào không hợp lệ bị bỏ qua .
(* nhập một 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;
GV : Võ Thị Sen
24
BÀI TẬP CƠ BẢN
Readln;
END.
Bài 6 :
Hãy lập chương trình nhập vào một 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 một 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 7 :
Viết chương trình có chức năng 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 cũng 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' 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']);
GV : Võ Thị Sen
25