1. Trang chủ
  2. » Ngoại Ngữ

bai tap pascal

68 1 0

Đang tải... (xem toàn văn)

Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 68
Dung lượng 60,48 KB

Nội dung

Vieát haøm tính D (St1 , St2) , vôùi U, V laø hai xaâu kí töï baát kì , laø toång soá caùc kí töï khoâng gioáng nhau trong hai xaâu treân , moãi loaïi kí töï chæ ñöôïc nhôù moät laàn...[r]

(1)

BÀI TẬP CHƯƠNG 1:CÂU LỆNH IF ….THEN…

* Baøi :

Nhập số a , b , c Hãy kiểm tra xem ba số độ dài ba cạnh tam giác hay không ? Thông báo lên hình ‘ Thỏa mãn ‘, ‘ Khơng thỏa mãn trường hợp tương ứng

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

* Baøi :

Nhập N số

Đếm số lớn 10 nhỏ 20 tính tổng chúng Sau , đưa hình :So cac so >10 <20 la : ( gia tri ) ;Tong cua chung la : ( gia tri )

GIAÛI

Var Tong , So : Real ; I , N , Dem : Integer ; BEGIN

Write (' Bao nhieu so : ') ; Readln ( N ) ; Tong := ; Dem := ;

For I := To N Do Begin

Write (' So = ') ; Readln ( So ) ; If ( So > 10 ) and ( So < 20 ) Then Begin

(2)

End ;

Writeln (' So cac so >10 va <20 la : ', Dem ) ; Writeln (' Tong cua chung la :', Tong ) ; Readln ; END

* Baøi :

Nhập bốn số a , b , c , d Hãy tìm giá trị lớn chúng gán giá trị lớn cho biến Max

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

* Baøi :

Đọc ngày tháng năm , sau viết hình ngày 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

(3)

: 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 hình 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 ( 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

GIAÛI

Uses Crt ; Var SBD : Integer;

Van , Toan , Ngoaingu , Tongdiem : Real ; BEGIN

Clrscr ;

Write (' So bao danh : ') ; Readln( SBD ) ; Write (' Diem toan : ') ; Readln( Toan ) ;

Write (' Diem ngoai ngu : ') ; Readln( Ngoaingu ) ; Write (' Diem van : ') ; Readln ( Van ) ;

Tongdiem := Toan + Van + Ngoaingu ; Clrscr ;

Writeln (' Phieu Bao Diem ') ;

Writeln (' So bao danh : ', SBD ) ; Writeln (' Diem van : ', Van ) ; Writeln (' Diem toan : ', Toan ) ; Writeln (' Diem ngoai ngu : ', Ngoaingu) ; Writeln (' Tong diem : ', Tongdiem) ; If Tongdiem >= 15 Then

(4)

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 in kết phép tính

Nếu “+” , in kết tổng lên hình Nếu “-” , in kết hiệu lên hình Nếu “/” , in kết thương lên hình

Nếu “*” , in kết tích lên hình Nếu “+” , in kết tổng lên hình

Nếu “+” , in kết tổng lê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

* Baøi :

Giải biện luận phương trình : x2 + ( m – ) x + = 0

m tham số thực tuỳ ý GIẢI

Uses Crt; Var m , Delta : Real ; BEGIN

Clrscr;

Write (' m = ') ; Readln( m ) ; Delta := sqr( m-2 ) - ; If Delta < Then

Writeln(' Phuong trinh vo nghiem ') Else

(5)

If Delta = Then

Writeln(' Phuong trinh co nghiem kep X= ', -( m - ) / ) Else

Begin

Writeln(' Phuong trinh co nghiem : ') ; Writeln (' X1 = ', ( -(m-2) + sqrt(delta) ) / ) ; Writeln (' X2 = ', ( -(m-2) - sqrt(Delta) ) / ) ; End ;

End ; Readln ; END

* Baøi :

Viết chương trình nhập hai số tự nhiên N, M thơng báo ‘Dung‘ N , M tính chẵn lẽ , trường hợp ngược lại thơng báo ‘Sai‘

GIAÛ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Đ VÀ KHÔNG XÁC ĐỊNH

Sử dụng lệnh For

* Baøi :

Lập trình tính tích 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 kí tự thuộc bảng chữ 50 lần

(6)

GIAÛ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 hình kí tự số lần xuất *)

Readln ; END

* Bài :Cho số tự nhiên n , lập trình để tính tổng sau :

(7)

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 )

GIAÛ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 :

(8)

ở n 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 , a thực 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 hình số khác GIẢI

(9)

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

(10)

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

* Baø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 phần tử dãy lớn a

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

Baøi 10 :

(11)

GIAÛI Uses crt ;

Var a , b : Array[1 50] Of Integer ; n , m , i , j , k : Byte ;

trung : Boolean ; BEGIN

Clrscr ;

Write (' Nhap dai cua day so nguyen : ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua day : ') ;

For i := To N Begin

Write (' a[', i ,'] = ') ; Readln( a[i] ) ; End ;

i := ; m := ; Repeat

trung := false ; j := i + 1; Repeat

If ( j <= n ) and ( a[i] = a[j] ) Then trung := true ; inc (j) ; Until trung or ( j > n ) ;

If trung Then Begin

m := m + 1;

b[m] := a[i] ; writeln ( b[m] : ) ; End ;

inc(i) ; Until i > n ; If m > Then Begin i := ; Repeat j := i + ; Repeat

trung := false ;

If b[i] = b[j] Then trung := true ; If trung Then

Begin If j < m Then

For k := j To m - Do b[k] := b[k + 1] ; m := m - ;

(12)

End ; inc ( j ) ; Until j > m ; inc ( i ) ; Until i > m ; End ;

If m > Then

For k := To m Do Write ( b[k] : ) ; Readln ; END

* Baøi 11 :

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 x Vậy phải để

GIAÛI

uses crt ; var

thang : Byte ; tien , lai , x : Real ; BEGIN

clrscr ;

writeln (' Chuong trinh tinh thoi gian rut tien lai ') ; write (' So tien lai muon rut : ') ; 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 12 :

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

(13)

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:CHƯƠNG TRÌNH CON

Baø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ố 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 = 0

GIAÛI

Uses Crt ;

Var a, b, c, x1, x2: real;

(*================================*) Procedure Nhapabc(var aa,bb,cc: real);

Begin

(14)

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

Clrscr;

Writeln(' Giai Phuong Trinh Bac Hai Voi Cac He So :'); Nhapabc(a,b,c);

If a<>0 then GPTB2

Else Writeln(' Khong phai phuong trinh bac hai '); Readln ; END

Baøi :

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

(15)

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 ;

Baøi :

Viết chương trình thự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ố 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 trung tuyến tam giác _ Viết hồn thiện chương trì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

(16)

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

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 <

4 GIAÛ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

(17)

If (X+Y+Z=12) then Writeln(' x=',X,' y=',Y, 'z=',Z); Readln;

End

Baøi :

Cho trước số N , a , b , c tự nhiên Giải phương trình sau phạm vi số ngun khơng âm x + y + z = N với điều kiện x < a , y < b , z < c

GIAÛ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 ;

(18)

End

Baø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 S2 , tìm tất kí tự có hai xâu Xâu Kq chứa tất kí tự , kí tự nhớ lần

GIAÛI Uses Crt;

Var xau1,xau2,xau: string;

(*==================================*) Procedure compare(s1, s2: string; Var kq: string); Var i: byte;

(*===============================*) Function kt(ch: char; st: string): boolean;

(* Kiểm tra xem kí tự Ch có xâu St khơng Nếu có hàm trả giá trị True Nếu khơng hàm trả giá trị False *) Begin

kt:=pos(ch,st)<>0; End;

(*================================*) Begin (* Thaân thủ tục Compare*)

kq:=''; (* Xâu roã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 ');

(19)

Baøi :

Viết hàm tính D (St1 , St2) , với U, V hai xâu kí tự , tổng số kí tự khơng giống hai xâu , loại kí tự nhớ lần Ví dụ D (‘aabba’ , ‘bcdd’) = có hai kí tự a d không giống xâu

GIAÛI

Uses Crt; Const M=100;

Var S: array[1 M] of string; max, min, i, j, n: byte;

(*===============================*) Function D(U,V: string): byte;

(*Trả tổng số loại kí tự khơng giống xâu U 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 ;

(20)

BEGIN (* Chương trì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 hồn chỉnh thự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 số nguyên tố ) 3 Thốt khỏi chương trình

GIAÛI

Uses Crt;

Type uoc_nguyen_to=array[1 50] of longint; Var

u, N: longint; i, dem: integer; a: uoc_nguyen_to;

(*================================*) Procedure nhap(Var NN:longint);

Begin Repeat

Write('Nhap N='); Readln(NN); Until NN>=0;

End;

(*=================================*) Procedure viet;

Begin

If dem=0 then

Writeln('So ',N,' khong the phan tich ' + 'tich cua cac so nguyen to') Else

(21)

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

BAØI TẬP CHƯƠNG 4: CẤU TRÚC DỮ LIỆU MẢNG

Baøi :

(22)

a21x + a22y = c2

GIAÛI Uses Crt;

Var a: array[1 2, 2] of real; c: array[1 2] of real;

d, dx, dy, x, y: real; BEGIN

Clrscr;

Writeln('Giai he phuong tring tuyen tinh hai an:'); Writeln(' a11x+a12y=c1');

Writeln(' a21x+a22y=c2');

Writeln('Nhap cac he so cua he phuong trinh'); Write('a11='); Readln(a[1,1]);

Write('a12='); Readln(a[1,2]); Write('c1='); Readln(c[1]); Write('a21='); Readln(a[2,1]); Write('a22='); Readln(a[2,2]); Write('c2='); Readln(c[2]); d:=a[1,1]*a[2,2] - a[2,1] * a[1,2]; dx:=c[1]*a[2,2] - c[2] * a[1,2]; dy:=a[1,1]*c[2] - a[2,1] * c[1];

If d=0 then Writeln(' He vo nghiem hoac vo so nghiem') Else

Begin

x:=dx/d; y:=dy/d;

Writeln('He co nghiem nhat :'); Writeln('x=', x:0:2, ' ; y=', y:0:2); End ;

Readln; END

Baøi :

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 ;

(23)

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ố ngun dương m , n Sau tính trung bình cộng bình phương 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

Baøi :

Viết chương trình nhập từ bàn phím 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

(24)

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

Baøi :

Dãy số sau gọi dãy Fibonaci : a1 =

a2 =

a3 =

a4 =

an = an-1 + an-2

Viết chương trình tính 20 số Fibonaci đư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

Baøi :

Dãy số an định nghĩa sau :

a1 =

a2 =

an = 2an-1 + an-2 ( n > )

(25)

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

Baøi :

Nhập số tự nhiên N viết chương trình tạo mảng bao gồm N số nguyên tố 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

for j:=1 to n begin

(26)

d:=FALSE;

if j>1 then for k:=1 to j-1 if a[i,k]=ba then d:=true; if i>1 then for k:=1 to i-1 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

for j:=1 to n write(a[i,j]:8); readln;

END

Bài :

Viết chương trình nhập bảng số x với điều kiện số nhập hình vị trí bảng số

Uses Crt; Var

a : array[1 3, 3] of integer ; i, j: byte ;

BEGIN Clrscr;

Writeln('Nhap mot bang so nguyen kich thuoc 3x3:'); Gotoxy(10, 4); Write(1);

(27)

Gotoxy(5,10); Write(3); For i:=1 to

For j:=1 to Begin

Gotoxy(9*j-1, 2*i+4); Read(a[i, j]);

Gotoxy(9*j-1, 2*i+4); ClrEol; Write(a[i, j]:6); End;

Readln; END

Baøi :

a a Viết chương trình nhập liệu từ dãy đối xứng vào mảng chiều

b b Viết chương trình nhập liệu 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];

(28)

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 ;

BAØI TẬP CHƯƠNG 5: XÂU KÝ TỰ

Baøi :

Lập trình đếm số lần xuất loại kí tự thuộc bảng chữ tiếng Anh xâu kí tự Str

Var A: array [ 'A' 'Z'] of integer; S: string;

ch: char; i: integer; BEGIN

(29)

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

Baøi :

Cho số tự nhiên n xâu có độ dài n Hãy biến đổi xâu cho cách thay đổi :

a a Tất dấu ! dấu chấm

b b Mỗi nhóm dấu chấm liền dấu chấm

c c Một nhóm 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

(30)

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;

(31)

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

Baøi :

Cho số tự nhiên n dãy kí tự S1 , S2 , … , Sn Hãy tìm số tự nhiên I cho

(32)

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

Baøi :

Cho số tự nhiên n dãy kí tự S1 , S2 , … , Sn Biết dãy có dấu phẩy

Hãy tìm số tự nhiên i cho : a. a Si dấu phẩy

b. b Si dấu phầy cuối cuø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);

(33)

Readln; END

Baøi :

Viết chương trình nhập xâu kí tự , sau xem xâu có phải xâu đối xứng không ( xâu đối xứng xâu có kí tự giống đố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ó loại kí tự khác ( phân biệt chữ in hoa với chữ in thường ) Ví dụ với S “Pascal” ta có đáp số

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;

(34)

Write('So ki tu khac cua xau S la: ', Dem); Readln;

END

Baøi :

Viết chương trình nhập xâu kí tự 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

Baøi :

Họ tên học sinh nhập từ bàn phím Bạn viết chương trình điều chỉnh lại kí tự đầu 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

Baø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 xố kí tự trống hai đầu xâu Ví dụ nhập xâu “ Ha noi “ , kết “Ha Noi”

ar S: String; BEGIN

(35)

While (S[length(S)] = #32) Delete(S,length(S),1); Write('Chuoi sau da bien doi la: ', S);

Readln; END

BAØI TẬP CHƯƠNG 6: DỮ LIỆU KIỂU TẬP

Baøi :

Bạn 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;

(36)

END

Bài :

Bạn lập chương trình tạo tập hợp số nguyên chẵn kiểu Byte loại khỏi số chia hết cho Kết thể 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

(37)

Write('Bam Enter de ket thuc '); Readln;

END

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

Baøi :

Bạn lập chương trình hiển thị menu dạng sau hình Xem

2 Sua chua

3 Loai bo 4 Nhap them

5 Thoat

Lua chon cua ban : _

(38)

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

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

(39)

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 kí tự nhập vào phải chữ thuộc bảng chữ tiếng Anh , bỏ qua phím khác

(* Nhập xâu tồn chữ *) 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

Baø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 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:=[];

(40)

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ố chữ 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 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;

(41)

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

Baøi :

Thông tin học sinh ghi gồm 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ố chữ 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 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

(42)

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

Baøi :

Một file ghi chứa danh sách học sinh , thông tin học sinh giống Hãy lập chương trình tạo file ghi khác chứa danh sách , ghi gồm 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ữ viết hoa (* Doi kieu ban ghi *)

Uses Crt;

Type Danhsach1=record holot: string[25]; ten: string[10]; tuoi: 99; lop: string[3]; End;

(43)

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;

(44)

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

Baøi :

Một file ghi chứa danh sách học sinh PTTH , thơng tin học sinh ngồi trường Họđệm , Tên , Tuổi , Lớp giống 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 hình danh sách học sinh giỏi trường bạn có

điểm trung bình từ 8.0 trở lên 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 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;

(45)

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

(46)

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

Baø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 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;

(47)

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

(48)

End; BEGIN ClrScr; Nhap; Timkiem;

Write('Ban Enter de ket thuc '); Readln;

END

Baøi :

File ghi F chứa danh sách ngày lễ năm , ghi gồm ngày tháng , tên ngày lễ số ngày nghỉ Hãy lập chương trình nhập danh sách ngày lễ tính :

  Tổng số ngày lễ tổng số ngày nghỉ lễ năm

  Tổng số ngày lễ tổng số ngày nghỉ lễ q , q , …

Kết thể 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;

(49)

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;

(50)

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 số nguyên tố nhỏ 10000 theo thứ tự tăng dần

(* Taï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

Baøi :

Cho f tệp văn chứa xâu 10 kí tự Hãy lập chương trình nhập hiển thị nội dung file lên hình , xâu dịng , đầy trang hình dừng lại đợi gõ Enter hiển thị trang hết

(* Ghi đọc file of String *) Uses Crt;

(51)

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

Baøi :

Bạn viết chương trình cho phép đọc liệu từ bàn phím ghi thêm vào cuối tệp ghi

(* Doc ghi vào cuối tệp ghi *) Uses Crt;

(52)

Ten : String[30]; Tuoi: Byte; End;

Var F : file of Hocsinh; Hs: Hocsinh; BEGIN

Assign(f,inp); Reset(f);

Write('Ho va ten: '); Readln(Hs.Ten); Write('Tuoi : '); Readln(Hs.Tuoi); Seek(f,Filesize(F));

Write(f,Hs); Close(f); END

Baøi :

Cho văn chứa text file f Trong văn , tính từ trái sang phải , từ xuống , kí tự # kí hiệu xố từ đứng trước có Ví dụ ‘#Ta#oi di ngu#h###hoc’ có nghĩa ‘Toi di hoc’ Bạn viết chương trình sửa lại file f theo quy ước

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

(53)

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

Baøi :

Cho file f g kiểu ( không rõ kiểu ) Bạn 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

(54)

Cho moät 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 theo cách sau :

Cách : Kiểm tra xem số lượng dấu ‘ ( dấu mở dấu đóng ) có không ? Cách : Kiểm tra xem số lượng từ Begin End có khơng ?

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

Baøi :

Cho file text Hãy viết chương trình đếm xem file text chứa từ ( Chú ý : theo quy định , từ cách hay nhiều dấu cách )

(* Đếm từ *) Uses Crt;

Const fi = 'hoten.txt'; Var f: text;

(55)

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

Baøi :

Cho file text Viết chương trình loại bỏ khoảng trống thừa bên file text

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

(56)

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 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; (* Tìm vị trí cuối *) q:=p;

p:=l; For i:=3 to k p:=p^.next; (* Tìm vị trí đầu *) If k=1 then l:=q Else p^.next:=q;

(57)

Procedure In_kq; Begin

While (l^.next<>nil) Begin

Writeln(l^.name); l:=l^.next;

End; Readln; End; BEGIN Nhap; Gobo; In_kq; END

Baøi :

Bạn 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;

(58)

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

Baøi :

Bạn 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;

(59)

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;

(60)

Nhap; Doicho; In_kq; END

BAØI TẬP CHƯƠNG 10: ĐỒ HỌA

Baøi :

Vẽ hình chữ nhật có tâm trùng với tâm hình , cạnh song song tỉ lê với cạnh 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 , kích thước điều khiển Nếu gõ phím + hình lớn lên , gõ phím – nhỏ , gõ Enter 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;

(61)

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

Baøi :

Một bàn cờ vua hiển thị 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 , ô bị hâu khống chế tô màu xanh Bạn lập chương trình thực yêu cầu

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

(62)

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

Baøi :

Vẽ đồng hồ điện tử hoạt động 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);

(63)

LeadingZero:=s; End;

BEGIN

GD:=Detect;

InitGraph(GD,GM,' ');

SetTextStyle(DefaultFont,HorizDir,5); Repeat

GetTime(h,m,s,hund);

St:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s); SetColor(15);

OutTextXY(150,200,St); Delay(1000);

SetColor(0);

OutTextXY(150,200,St); Until KeyPressed;

CloseGraph; END

Baøi :

Hiển thị điểm chuyển động theo chiều kim đồng hồ quỹ đạo tròn , tâm tâm 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; (* goùc *) BEGIN

Gd:=Detect;

InitGraph(Gd,Gm,' ');

x0:=GetMaxX div 2; y0:=GetMaxY div 2; PutPixel(x0,y0,4);

a:=0; Repeat

x:=x0+Round(r*cos(a)); y:=y0+Round(r*sin(a)); PutPixel(x,y,15);

(64)

PutPixel(x,y,0); a:=a+0.01; Until KeyPressed; CloseGraph; END

Bài :

Hiển thị hình chữ nhật hình , vị trí điều khiển bàn phím Gõ phím mũi tên để dịch chuyển hình theo 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;

(65)

If x<0 then x:=600; If y>440 then y:=0; If y<0 then y:=440; Until (c=#27)or(c=#13); CloseGraph;

END

Baøi :

Vẽ hình sau với phơng chữ , 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;

(66)

SetTextStyle(Font,HorizDir,Size); Str(Size,S); S:='Size '+S;

OutTextXY(100,i*80,S) ; End;

Readln; End;

CloseGraph; END

Baøi :

Vẽ hệ trục toạ độ đồ thị hàm số y = x2 với đầy đủ 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;

(67)

x:=(i-X0)/E; y:=Sqr(x); j:=Round(-y*E+Y0); PutPixel(i,j,10);

End;

SetTextStyle(1,0,2);

OutTextXY(100,400,'Do thi ham so y = Sqr(x):'); Readln;

CloseGraph; END

Baøi :

Vẽ tô màu cho nhà sau Đảm bảo khả bật tắt điện cho nhà Nếu gõ phím + đèn sáng ( cửa sổ có màu trắng ) , gõ phím – đè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);

(68)

Floodfill(320,190,White); SetFillPattern(Pattern,8); Floodfill(320,220,White); Repeat

Repeat c:=ReadKey; Until c in [#27,'+','-']; If (c='+') then SetFillPattern(Pattern,14) Else If (c='-') then SetFillPattern(Pattern,0);; Floodfill(270,300,White);

Floodfill(370,270,White); Until c=#27;

CloseGraph; END

MUÏC LUÏC

Ngày đăng: 19/05/2021, 11:09

TÀI LIỆU CÙNG NGƯỜI DÙNG

  • Đang cập nhật ...

TÀI LIỆU LIÊN QUAN

w