Tuyển tập các bài toán Pascal - Pdf 16

¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
 Bµi tËp:
C¢U LƯNH IF … THEN … ELSE
Bài 1 :Nhập 3 số a , b , c bất kì . Hãy kiểm tra xem ba số đó có thể là độ dài ba cạnh của một tam
giác hay không ? Thông báo lên màn hình ‘ Thỏa mãn ‘, ‘ Không thỏa mãn trong từng trường hợp tương
ứng .
Bài 2 :Nhập N số bất kì .
Đếm các số lớn hơn 10 và nhỏ hơn 20 và tính tổng của chúng . Sau đó , đưa ra màn hình :
So cac so >10 và <20 la : ( gia tri )
Tong cua chung la : ( gia tri )
Bài 3 :Nhập bốn 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 .
Bài 4 :Đọc ngày tháng năm , sau đó viết ra màn hình đó là ngày thứ mấy trong tuần .
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ố báo danh :
_ Điểm văn :
_ Điểm toá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 .
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 .

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 .
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
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 .
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 .
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.
Ph¹m T¨ng Tïng
1
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
Bài 10 :Viết chương trình nhập một dãy số tối đa 50 số rồi in ra màn hình các số trùng nhau của
dãy .
Bài 11 :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
Bài 12 :Viết chương trình tìm ƯSCLN của N số được nhập từ bàn phím .
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 .
Bài 2 :Dùng thủ tục giải phương trình bậc hai ax
2
+ bx + c = 0.
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 ý .
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 ?


Bài 2 :Lập phương trình tạo ra một mảng chứa bảng cửu chương .
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 .
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 .
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ử .
Bài 6 :Dãy số a
n

c. Một nhóm các dấu chấm đứng liền nhau bằng dấu ba chấm .
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 .
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. S
i
là dấu phẩy đầu tiên . b. S
i
là dấu phầy cuối cùng .
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’ ) .
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¹m T¨ng Tïng
3
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«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 .
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
.
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 .
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 .
CÊU TRóC D÷ LIƯU KIĨU RECORD
Bài 1 :Thông tin về mỗi học sinh gồm :
 Họ đệm : một xâu 25 kí tự .
 Tên : một xâu 10 kí tự .
 Tuổi : một số nguyên hai chữ số .
 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ỗi người một dòng .
Bài 2 :Thông tin về mỗi học sinh là một bản ghi gồm các trường :
 Họđệm : một xâu 25 kí tự .
 Tên : một xâu 10 kí tự .
 Tuổi : một số nguyên hai chữ số .
 Lớp : một xâu hai chữ số và một chữ cái viết hoa
Một file bản ghi chứa một danh sách một 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 , mỗi người một dòng .
Bài 3 :Một file bản ghi chứa một danh sách học sinh , thông tin về mỗi học sinh giống như bài trên .
Hãy lập chương trình tạo một file bản ghi khác chứa danh sách đó , mỗi bản ghi gồm các trường :
 Họtên : một xâu 35 kí tự .
 Tuổi : một số nguyên hai chữ số .

¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
Bài 2 :Cho f là tệp văn bả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 , mỗi xâu một dòng , đầy trang màn hình thì dừng lại đợi gõ Enter mới hiển thò trang
tiếp theo cho tới hết.
Bài 3 :Bạn hãy viết chương trình cho phép đọc dữ liệu từ bàn phím và ghi thêm vào cuối một tệp
các bản ghi .
Bài 4 :Cho một văn bản chứa trong một text file f . Trong văn bản , tính từ trái sang phải , từ trên
xuống dưới , kí tự # là kí hiệu xoá đi một từ đứng ngay trước nó nếu 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 .
Bài 5 :Cho 2 file f và g cùng kiểu ( nhưng không rõ kiểu nào ) . Bạn hãy lập thủ tục gán nội dung của
file g cho file f.
Bài 6 :Cho một file text ghi lại một chương trình Pascal của một học sinh . Hãy viết chương trình kiểm
tra lỗi của chương trình Pascal trên theo các cách sau đây :
Cách 1 : Kiểm tra xem số lượng các dấu ‘ ( dấu mở và dấu đóng ) có bằng nhau không ?
Cách 2 : Kiểm tra xem số lượng các từ Begin và End có bằng nhau không ?
Bài 7 :Cho một 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 nhau bởi một hay nhiều dấu cách ) .
Bài 8 :Cho một file text . Viết chương trình loại bỏ các khoảng trống thừa bên trong file text này .
CÊU TRóC D÷ LIƯU KIĨU CON trá
Bài 1 :Bạn hãy lập chương trình cho phép ta nhập từ bàn phím một danh sách được ghép nối . Sau
đó gỡ bỏ một record khỏi danh sách .
Bài 2 :Bạn hãy lập chương trình cho phép nhập một danh sách được ghép nối . Sau đó chèn thêm
một record vào danh sách .
Bài 3 :Bạn hãy lập chương trình cho phép nhập một danh sách được ghép nối . Sau đó đổi chỗ hai
record trong danh sách .
§å HäA
Bài 1 :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 .
Bài 2 :Vẽ hình chữ nhật như trên , kích thước điều khiển được . Nếu gõ phím + thì hình lớn lên , gõ
phím – thì nhỏ đi , gõ Enter thì dừng chương trình .

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 .
2) 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 ;

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 .
5) Uses Crt ;
Var SBD : Integer;
Van , Toan , Ngoaingu , Tongdiem :
Real ;
BEGIN
Clrscr ;

a , b , T : Real ;
Pt : Char ;
BEGIN
Clrscr ;
Write (' a = ') ; Readln( a ) ;
Write (' b = ') ; Readln( b ) ;
Write (' Phep tinh thuc hien la (+
- * /) : ') ;
Readln( Pt ) ;
If Pt = '+ Then T := a + b ;
If Pt = '- Then T := a - b ;
If Pt = '* Then T := a * b ;
If Pt = '/ Then T := a / b ;
Write ( a , pt , b , ' = ', T ) ;
Readln ;
END .
7) 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
If Delta = 0 Then
Writeln(' Phuong trinh co

1)Var i : Byte ; (* chỉ số chạy *)
p : word ; (* tích số *)
BEGIN
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 .
2)
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ự

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 .
4)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 .
5) Uses Crt ;
Var i , n : Integer ;
tong: Real ;
BEGIN
Clrscr ;
Write (' Cho so tu nhien n : ') ;
Readln (n) ;
tong :=0 ;
i :=1 ;

Readln ;
END .
7) 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 .
8) Uses Crt;
Var A : Array [1 100] Of Integer ;

;
Readln ;
END .
9) 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 .

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 ;
inc ( i ) ;
Until i > m ;
End ;
If m > 0 Then
For k := 1 To m Do Write

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 .
CH¦¥NG TR×NH CON
1) 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

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

' 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;
(*================================*)

(*================================*)
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 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);

6) 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) 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

¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
Begin (* Thân của thủ tục
Compare*)
kq:=''; (* Xâu rỗ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 .
8)
Uses Crt;
Const M=100;
Var S: array[1 M] of string;
max, min, i, j, n: byte;
(*===============================*)

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;
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 .
9)
Uses Crt;
Type uoc_nguyen_to=array[1 50] of
longint;
Var

Procedure phantich(N1:longint);
Begin
If N1>1 then
Ph¹m T¨ng Tïng
13
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
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

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 .
2)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 .
3)Var m , n , k , s : Word ;
tb : real ;
BEGIN

mang : ') ;
For i := 1 To m Do
For j := 1 To n Do
Ph¹m T¨ng Tïng
14
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
Begin
Write ('a[', i:2, ', ' ,
j:2 ,']=') ; Readln(a[i, j]) ;
End ;
Readln ;
END .
5)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.
6)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] ;

end;
for i:=1 to n do
for j:=1 to n do write(a[i,j]:8);
readln;
END .
8) 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;
ba:=ba+1;
until not d;
a[i,j]:=ba-1;
end;

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 ;
Phạm Tăng Tùng
15
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
END .
XÂU Kí Tự
1) 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;

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)
Else
If (i-j)>2 then
Begin
Delete(S,j+2,i-j-2);
i:=j+1;
End;
End ;
Inc(i);
End;

b )
Var S: string;
i: integer;
BEGIN
Write('Cho mot xau S co dau ",":
'); Readln(S);
i:= length(S);
Phạm Tăng Tùng
16
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
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 .
5)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

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 .
8)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 .
9)Var S: String;
BEGIN
Write('Cho mot xau ky tu: ');

n:=0;
For i:=0 to 99 do If i in S then
Inc(n);
Card:=n;
End;
BEGIN
Phạm Tăng Tùng
17
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
Nhap;
Clrscr;
Write('Tap S co ',Card(S),' phan
tu.');
Readln;
END.
2)
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:');

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;

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
Ph¹m T¨ng Tïng
18
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
Else if ch<>#13 then Write(#7);
If ch=#0 then ch:=Readkey;
Until ch = #13;
END .
7)(* 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];

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;
Write('Bam Enter de ket thuc ');
Readln;

3) (* 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;
Phạm Tăng Tùng
19
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
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);

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
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

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);
Phạm Tăng Tùng
20
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
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;
END .
5) (* Tim kiem tren ban ghi *)

While
(i<=n)and((ds[i].tacgia<>tacgia)or(ds[i
].namXB<>namXB)) do i:=i+1;
If (i>n) then Writeln('Khong tim
duoc')
Else
Writeln(ds[i].tacgia:28,ds[i].tensach:4
2,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:4
2,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

FILE
1) (* 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;
BEGIN
For i:=2 to N do a[i]:=true;
i:=2;
Phạm Tăng Tùng
21
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
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 .

continue ');
Readln; Clrscr;
End;
End;
Close(f);
Readln;
End;
BEGIN
Ghi;
Doc;
END.
3) (* Doc và ghi vào cuối tệp các
bả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);

Close(f);
Assign(f,fi); Rewrite(f);
Writeln(f,s);
Close(f);
Writeln(' Van ban sau khi sua
chua :') ;
docfile(fi) ;
Ph¹m T¨ng Tïng
22
Ước mơ + Tự tin + Quyết tâm + Kiên trì + Bền bỉ + Kiên định Chủ quan = THàNH CôNG
Readln;
END .
5) (* 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 ');
If Dem('End')<>Dem('Begin') then
Writeln('khong bang nhau.')
Else Writeln('bang nhau.');
Readln;
END .
7) (* ẹ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);

inc(dem);
While (s[1]<>'
')and(length(s)>0) do Delete(s,1,1);
End;
End;
End;
Phạm Tăng Tùng
23
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
End;
Close(f);
Write(' So tu co trong file
hoten.txt la: ',dem);
Readln;
END.
CÊU TRóC D÷ LIƯU KIĨU
CON trá
1)(* Gỡ bỏ bản 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;

BEGIN
Nhap;
Gobo;
In_kq;
END.
2)
(* Chèn thêm bản 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) do
Begin
Readln(f,p^.name);
New(p^.next);
p:=p^.next;
End;
p^.next:=nil;
Close(f);

END.
Ph¹m T¨ng Tïng
24
¦íc m¬ + Tù tin + Qut t©m + Kiªn tr× + BỊn bØ + Kiªn ®Þnh – Chđ quan = THµNH C«NG
3) (* Đổi chỗ 2 bản ghi trong 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) do
Begin
Readln(f,p^.name);
New(p^.next);
p:=p^.next;
End;
p^.next:=nil;
Close(f);
Clrscr;

1) (* 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 do
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.
2) (* Hình chữ nhật kích thước điều
khiển được *)
Uses Crt, Graph;
Var Gd,Gm,x,y: Integer;
tl: real;
c: char; BEGIN
Gd:=Detect;
InitGraph(Gd,Gm,'');

Ph¹m T¨ng Tïng
25


Nhờ tải bản gốc

Tài liệu, ebook tham khảo khác

Music ♫

Copyright: Tài liệu đại học © DMCA.com Protection Status