giao an boi duong hoc sinh gioi tin hoc 20162017

Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (262.24 KB, 47 trang )

(1)CHUYÊN ĐỀ HỌC SINH GIỎI TIN 8 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 . 1) 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ì . Đế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 ) 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 ; End ; Writeln (' So cac so >10 va <20 la : ', Dem ) ; Writeln (' Tong cua chung la :', Tong ) ; Readln ; END . 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 . 3) 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 (2) Writeln (' Gia tri lon nhat la : ', Max ) ; Readln ; END . 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 . 4) 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 ) * 3div 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ố 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 . 5) Uses Crt ; Var SBD : Integer; Van , Toan , Ngoaingu , Tongdiem : Real ; BEGIN Clrscr ; Write (' So bao danh : ') ; Readln( SBD ) ; Write (' Diem toan : ') ; Readln( Toan ) ; Write (' Diem ngoai ngu : ') ; Readln( Ngoaingu ) ; Write (' Diem van : ') ; Readln ( Van ) ; Tongdiem := Toan + Van + Ngoaingu ; Clrscr ; Writeln (' Phieu Bao Diem ') ; Writeln (' So bao danh : ', SBD ) ; Writeln (' Diem van : ', Van ) ; Writeln (' Diem toan : ', Toan ) ; Writeln (' Diem ngoai ngu : ', Ngoaingu) ; Writeln (' Tong diem : ', Tongdiem) ; If Tongdiem >= 15 Then Writeln(' Ban da trung tuyen ') Else Writeln(' Ban khong trung tuyen ') ;.

(3) 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 . 6) Uses Crt ; Var 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 . Bài 7 :Giải và biện luận phương trình : x2 + ( m – 2 ) x + 1 = 0 ở đây m là tham số thực tuỳ ý . 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 nghiem kep X= ', -( m - 2 ) / 2 ) Else Begin Writeln(' Phuong trinh co 2 nghiem : ') ; Writeln (' X1 = ', ( -(m-2) + sqrt(delta) ) / 2 ) ; Writeln (' X2 = ', ( -(m-2) sqrt(Delta) ) / 2 ) ; End ; End ; Readln ; END . Bài 8 :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‘. 8) Uses Crt ; Var N , M : Integer ; Begin.

(4) Clrscr ; Write(' N , M = ') ; Readln( N , M ) ; If ( (N + M) mod 2 = 0 ) Then Writeln(' Dung ! ') Readln ; END .. Else Writeln(' Sai ! ') ;. 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 . 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) . Bài 3 :Cho số tự nhiên n , hãy lập trình để tính các tổng sau : a. 1 + 1/22 + 1/32 + … + 1/n2 b. 1 + 1/2! + 1/3! + … + 1/n! Bài 4 :Tính giá trị của biểu thức sau : ( 1 + 1/12 ) ( 1 + 1/22 ) … ( 1 + 1/n2 ) 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 an , ở đâ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. 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 . 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 ;.

(5) 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 . 3)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 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 ;.

(6) 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 . 6) Uses Crt ; Var i , n : Integer ; a , giatri : Real ; BEGIN Clrscr ; Write (' Cho so a : ') ; Readln(a) ; Write (' Cho so mu n : ') ; Readln(n) ; i := 1 ; giatri := 1 ; While i <= n Do Begin giatri := giatri * a ; i:= i+1 ; End ; Writeln(' a mu n bang : ', giatri ) ; Readln ; END . 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 A[i] ) Do inc(j) ; If j = i Then Writeln( A[i] ) ; i :=i + 1 ; End ; Readln ; END ..

(7) 8) 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; End ; i := i + 1; End ; Writeln(' Day sau khi sap xep : ') ; For i := 1 To N Do Write(A[i] : 4) ; 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 ..

(8) 10) Uses crt ; Var a , b : Array[1..50] Of Integer ; n , m , i , j , k : Byte ; trung : Boolean ; BEGIN Clrscr ; Write (' Nhap do dai cua day so nguyen : ') ; Readln(n) ; Writeln (' Nhap cac phan tu cua day : ') ; For i := 1 To N do Begin Write (' a[', i ,'] = ') ; Readln( a[i] ) ; End ; i := 1 ; m := 0 ; Repeat trung := false ; j := i + 1; Repeat If ( j <= n ) and ( a[i] = a[j] ) Then trung := true ; inc (j) ; Until trung or ( j > n ) ; If trung Then Begin m := m + 1; b[m] := a[i] ; writeln ( b[m] : 4 ) ; End ; inc(i) ; Until i > n ; If m > 1 Then Begin i := 1 ; Repeat j := i + 1 ; Repeat trung := false ; If b[i] = b[j] Then trung := true ; If trung Then Begin If j < m Then For k := j To m - 1 Do b[k] := b[k + 1] ; m := m - 1 ; dec ( j ) ; End ; inc ( j ) ; Until j > m ; inc ( i ) ; Until i > m ; End ; If m > 0 Then For k := 1 To m Do Write ( b[k] : 4 ) ; Readln ; END . 11) uses crt ; var.

(9) thang : Byte ; tien , lai , x : Real ; BEGIN clrscr ; writeln (' Chuong trinh tinh thoi gian rut tien lai ') ; write (' So tien lai muon rut ra : ') ; readln(x) ; tien := 1000 ; thang :=1 ; repeat lai := tien * 8 / 100 ; tien := tien + lai ; thang := thang + 1 ; until tien >= x ; writeln (' Ban phai gui tien trong ', thang div 12 , ' nam ', thang mod 12 ,' thang .') ; writeln (' Khi do so tien ban rut ra duoc la ', tien:12:2 ,' dong .') ; readln ; END . 12) 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 .. 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 ax2 + 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 ? _ 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 ..

(10) 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. 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 . 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 . 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 . 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. Nhập dữ liệu ( nhập số tự nhiên n ) . 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. Thoát khỏi chương trình .. CẤU TRÚC DỮ LIỆU KIỂU MẢNG Bài 1 :Giải hệ phương trình tuyến tính hai ẩn dùng ma trận : a11x + a12y = c1 a21x + a22y = c2 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 : a1 = 1 a2 = 1 a3 = 2 a4 = 3 ... an = an-1 + an-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ố an được định nghĩa như sau : a1 = 1 a2 = 2 ... an = 2an-1 + an-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 . Bài 7 :Nhập số tự nhiên N và viết chương trình tạo mảng bao gồm N số nguyên tố đầu tiên . Bài 8 :Viết chương trình nhập một bảng số 3 x 3 với điều kiện các số được nhập sẽ hiện trên màn hình đúng tại vị trí của mình trên bảng số . Bài 9 :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 .. 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 . 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. Tất cả các dấu ! bằng dấu chấm . b. Mỗi một nhóm các dấu chấm liền nhau bằng một dấu chấm ..

(11) 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ự S1 , S2 , … , Sn . Hãy tìm số tự nhiên I đầu tiên sao cho các kí tự Si , Si+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ự S1 , S2 , … , Sn . 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. Si là dấu phẩy đầu tiên . b. Si 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â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 . 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 . 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 . 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” .. 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 . 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 . 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 đó . 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. Sua chua 3. Loai bo 4. Nhap them 5. Thoat Lua chon cua ban : _ Sau đó đợi gõ phím . Chương trình phải đợi 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 . 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 ..

(12) 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ố . Khối : một số nguyên hai chữ số . Lớp : một chữ cái viết hoa Bài 4 :Một file bản ghi chứa một danh sách học sinh PTTH , thông tin về mỗi học sinh ngoài các trường Họđệm , Tên , Tuổi , Lớp giống như các bài trên còn có thêm trường Điểm chứa điểm trung bình của học sinh trong năm học . Hãy lập chương trình : a. Hiển thị lên màn hình danh sách những học sinh giỏi nhất của trường là những bạn có điểm trung bình từ 8.0 trở lên và cao nhất trong khối . b. Lập danh sách học sinh trong năm học mới , biết một học sinh có điểm trung bình từ 5.0 trở lên thì được lên lớp . Chú ý : lớp 10A lên lớp 11A , lớp 11A lên 12A ... Kết quả chứa trong file . Bài 5 :Cho file bản ghi f chứa dữ liệu về kho sách , dữ liệu về mỗi cuốn sách được chứa trong một bản ghi gồm 3 trường mang thông tin về : Họ tên tác giả : một xâu 26 kí tự . Tên sách : một xâu 40 kí tự . Năm xuất bản : một số nguyên 4 chữ số . Hăy lập chương trình nhập dữ liệu vào kho sách , sau đó tìm ra : Những cuốn sách của một tác giả cho trước xuất bản vào một năm cho trước . Những cuốn sách có tên cho trước . Kết quả hiện trên màn hình Bài 6 : File bản ghi F chứa danh sách các ngày lễ trong một năm , mỗi bản ghi gồm ngày tháng , tên ngày lễ và số ngày được nghỉ . Hãy lập chương trình nhập danh sách các ngày lễ và tính : Tổng số các ngày lễ và tổng số các ngày nghỉ lễ trong năm . Tổng số các ngày lễ và tổng số các ngày nghỉ lễ trong quí 1 , quí 2 , … Kết quả thể hiện trên màn hình .. CẤU TRÚC DỮ LIỆU KIỂU FILE Bài 1 :Hãy lập chương trình tạo một tệp số nguyên chứa các số nguyên tố nhỏ hơn 10000 theo thứ tự tăng dần ..

(13) 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ướng dẫn :. 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 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 ; 2) Uses Crt ; Var a, b, c, x1, x2: real; (*================================*).

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

(15) 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. 4) 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,.

(16) ' 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. 5) 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. 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.

(17) 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. 7) 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 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;.

(18) END . 8) 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 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 ..

(19) 9) Uses Crt; Type uoc_nguyen_to=array[1..50] of longint; Var u, N: longint; i, dem: integer; a: uoc_nguyen_to; (*================================*) Procedure nhap(Var NN:longint); Begin Repeat Write('Nhap N='); Readln(NN); Until NN>=0; End; (*=================================*) Procedure viet; Begin If dem=0 then Writeln('So ',N,' khong the phan tich thanh ' + 'tich cua cac so nguyen to') Else If dem=1 then Writeln(N, '=', a[dem]) Else Begin Write(N,'='); For i:=1 to dem-1 do Write(a[i],'*'); Writeln(a[dem]); End; End; (*================================*) 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;.

(20) Writeln('Phan tich so N thanh tich cua cac so nguyen to :'); nhap(N); phantich(N); Write('Nhan Enter de ket thuc ...'); Readln; END .. CẤU TRÚC DỮ LIỆU KIỂU MẢNG 1)Uses Crt; Var a: array[1..2, 1..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 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 ;.

(21) 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 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 . 4) 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 . 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] ; S := 0 ; For i := 1 to N do S := S+1/sqr(a[i]) ; Writeln (' S = ', S:12:6) ; Readln ; END. 7)var a:array[1..100,1..100]of byte; n,i,j,k,l,ba:byte;.

(22) 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 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 n do write(a[i,j]:8); readln; END . 9) 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:');.

(23) 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 .. 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; End; For ch:= 'A' to 'Z' do Writeln('So lan xuat hien cua ',ch,' trong xau la: ', A[ch]:4) ; Readln ; END . 2)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 ..

(24) 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) 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 . 3) 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 . 4)a ).

(25) 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 . 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 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 . 6)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);.

(26) Readln; END . 7)Var S : string; i : integer; 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: '); 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 .. DỮ LIỆU KIỂU TỆP 1)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:=[]; 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);.

(27) 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. 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:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Writeln; Writeln('Ban muon bo cac phan tu nao khoi tap hop:'); Repeat ch:=ReadKey; tap:=tap-[ch]; Writeln(ch); Until not(ch in ['a'..'z']); Writeln('Cac phan tu con lai cua tap hop la:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Readln; END . 3)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 ..

(28) 4) (* 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. 5)(* 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; Readln; END. 6) (* 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;.

(29) 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 . 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]; Writeln(ch); Until not(ch in ['a'..'z']); Writeln('Cac phan tu cua tap hop la:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Writeln; Writeln('Ban muon bo cac phan tu nao khoi tap hop:'); Repeat ch:=ReadKey; tap:=tap-[ch]; Writeln(ch); Until not(ch in ['a'..'z']); Writeln('Cac phan tu con lai cua tap hop la:'); For ch:='a' to 'z' do If ch in tap then Write(ch,' '); Readln; END .. CẤU TRÚC DỮ LIỆU KIỂU RECORD 1)(* 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: 0..99; lop: string[3];.

(30) 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; END. 2) (* Doc tu mot file ban ghi *) Uses Crt; Const n=5; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; end; Var ds: Danhsach; i: byte; f: file of Danhsach; BEGIN ClrScr; Writeln('Danh sach hoc sinh tu file bai2.dat'); Writeln; Assign(f,'bai2.dat'); Reset(f); For i:=1 to n do Begin Read(f,ds); With ds do Writeln(holot:20,ten:11,tuoi:4,lop:5); End; Close(f); Writeln; Write('Bam Enter de ket thuc...'); Readln; END . 3) (* Doi kieu ban ghi *) Uses Crt;.

(31) Type Danhsach1=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; End; Danhsach2=record hoten: string[35]; tuoi: byte; khoi: byte; lop: char; End; Var ds1 : Danhsach1; ds2 : Danhsach2; f1 : file of Danhsach1; f2 : file of Danhsach2; c : integer; BEGIN ClrScr; Writeln('Ghi tu file bai3.dat sang bai3n.dat:'); Writeln; Assign(f1,'bai3.dat'); Reset(f1); Assign(f2,'bai3n.dat'); Rewrite(f2); While not Eof(f1) do Begin Read(f1,ds1); With ds1 do Begin ds2.hoten:=holot+ten; val(copy(lop,1,2),ds2.khoi,c); ds2.tuoi:=tuoi; ds2.lop:=UpCase(lop[3]); Write(f2,ds2); End; End; Close(f1); Close(f2); Writeln; Writeln('Bam Enter de ket thuc!'); Readln; END . 4) (* Khen thuong va len lop *) Uses Crt; Type Danhsach=record holot: string[25]; ten: string[10]; tuoi: 0..99; lop: string[3]; diem: real; End; Var ds: array [1..100] of Danhsach; f: file of Danhsach;.

(32) n: integer; Procedure Nhap; Begin Assign(f,'bai4.dat'); Reset(f); n:=0; While not Eof(f) do Begin n:=n+1; Read(f,ds[n]); End; Close(f); End; Procedure Timgioi; Var i: integer; max10,max11,max12: real; l: string; Begin max10:=0; max11:=0; max12:=0; For i:=1 to n do With ds[i] do Begin l:=copy(lop,1,2); If (l='10')and(diem>max10)and(diem>8.0) then max10:=diem Else If (l='11')and(diem>max11)and(diem>8.0) then max11:=diem Else If (l='12')and(diem>max12)and(diem>8.0) then max12:=diem; End; Writeln('Hoc sinh gioi nhat khoi 10 : '); For i:=1 to n do With ds[i] do If (copy(lop,1,2)='10')and(diem>=max10) then Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1); Writeln('Hoc sinh gioi nhat khoi 11 : '); For i:=1 to n do With ds[i] do If (copy(lop,1,2)='11')and(diem>=max11) then Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1); Writeln('Hoc sinh gioi nhat khoi 12 : '); For i:=1 to n do With ds[i] do If (copy(lop,1,2)='12')and(diem>=max12) then Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1); End; Procedure Lenlop; Var i: integer; l: string; f: file of Danhsach; Begin For i:=1 to n do With ds[i] do Begin l:=copy(lop,1,2); If (l='10')and(diem>=5.0) then lop:='11'+lop[3] Else If (l='11')and(diem>=5.0) then lop:='12'+lop[3] Else If (l='12')and(diem>=5.0) then lop:='DTN'; End; Assign(f,'bai4n.dat'); Rewrite(f); For i:=1 to n do With ds[i] do.

(33) 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 *) Uses Crt; Type Danhsach=record Tacgia: string[26]; Tensach: string[40]; NamXB: integer; End; Var ds: array [1..100] of Danhsach; n : integer; f : file of Danhsach; M: Danhsach; Procedure Nhap; Begin n:=0; Assign(f,'bai5.dat'); Reset(f); While not Eof(f) do Begin Inc(n); Read(f,ds[n]); End; Close(f); End; Procedure TheoTG; Var tacgia: string; namXB: integer; i: integer; Begin Write('Cho ten tac gia : '); Readln(M.tacgia); Write('Cho nam xuat ban : '); Readln(M.NamXB); i:=1; While (i<=n)and((ds[i].tacgia<>tacgia)or(ds[i].namXB<>namXB)) do i:=i+1; If (i>n) then Writeln('Khong tim duoc') Else Writeln(ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6); End; Procedure TheoTS; Var ten: string; i: integer; Begin Write('Cho ten sach : '); Readln(ten); i:=1; While (i<=n)and(ds[i].tensach<>ten) do i:=i+1; If (i>n) then Writeln('Khong tim duoc').

(34) Else Writeln(ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6); End; Procedure Timkiem; Var c:char; Begin Writeln('1. Tim kiem theo tac gia va nam xuat ban.'); Writeln('2. Tim kiem theo ten sach'); Writeln; Write('Ban chon [1/2] : '); Repeat c:=Readkey; Until pos(c,'12')>0; Writeln(c); If c='1' then TheoTG Else TheoTS; End; BEGIN ClrScr; Nhap; Timkiem; Write('Ban Enter de ket thuc...'); Readln; END. 6) ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ................................................................................... ............................................................ ....................... ................................................................................... .................................... ............................................... ................................................................................... CU TRĩC D÷ LIƯU KIĨU FILE 1) (* Tạo file số nguyên tố nhỏ 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; 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;.

(35) 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 . 2) (* Ghi và đọc file of String *) Uses Crt; Const INP='FoString.dat'; Type String10 = String[10]; Procedure Ghi; Var f: file of String10; S: String10; Begin Assign(f,INP); Rewrite(f); Writeln('Nhap vao f. Thoi nhap khi S='''' (go Enter)!'); Readln(S); While (S<>'') do Begin Write(f,S); Readln(S); End; Close(f); End; Procedure Doc; Var f: file of String10; S: String10; Begin Clrscr; Assign(f,INP); Reset(f); While Not Eof(f) Do Begin 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. 3) (* Doc và ghi vào cuối tệp các bản ghi *) Uses Crt; Const inp='Hocsinh.dat'; Type Hocsinh=Record.

(36) 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 . 4) (* Sửa văn bả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) do Begin Read(f,ch); Write(ch); End; close(f) ; writeln ; End ; BEGIN Writeln(' Van ban ban dau doc tu file "vanban.txt" :') ; docfile(fi) ; assign(f,fi) ; reset(f) ; s:=''; Repeat Read(f,ch); If (ch='#')then Delete(s,length(s),1) Else s:=s+ch; Until Eof(f); Close(f); Assign(f,fi); Rewrite(f); Writeln(f,s); Close(f); Writeln(' Van ban sau khi sua chua :') ; docfile(fi) ; Readln; END ..

(37) 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; BEGIN Copyfile(f1,f2); END. 6) (* Dem (') và 'Begin' , 'End' *) Uses Crt; Const fi='C8_6.txt'; Function Dem(c: string): integer; Var n,l: integer; f: text; S: string; Begin l:=Length(c); n:=0; Assign(f,fi); Reset(f); While not Eof(f) do Begin Readln(f,S); While pos(c,s)<>0 do 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.').

(38) Else Writeln('bang nhau.'); Readln; END . 7) (* Đếm từ *) Uses Crt; Const fi = 'hoten.txt'; Var f: text; s: string; dem: word; BEGIN Clrscr; dem:=0; Assign(f,fi); Reset(f); While not Eof(f) do Begin Readln(f,s); While s[1]=' ' do Delete(s,1,1); While length(s)>0 do Begin Case s[1] of ' ': While (s[1]=' ')and(length(s)>0) do Delete(s,1,1); Else Begin inc(dem); While (s[1]<>' ')and(length(s)>0) do Delete(s,1,1); End; End; End; End; Close(f); Write(' So tu co trong file hoten.txt la: ',dem); Readln; END. 8)(* Đế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);.

(39) Else Begin inc(dem); While (s[1]<>' ')and(length(s)>0) do Delete(s,1,1); End; End; End; 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; New(p); l:=p; Write('Ten: '); Readln(p^.name); Repeat New(p^.next); p:=p^.next; Write('Ten: '); Readln(p^.name); Until p^.name=''; p^.next:=nil; Write('Vi tri ban ghi can go bo: '); Readln(k); End; Procedure Gobo; Var i: integer; q: Ptr; Begin p:=l; For i:=1 to k do p:=p^.next; q:=p; p:=l; For i:=3 to k do p:=p^.next; If k=1 then l:=q Else p^.next:=q; End; Procedure In_kq; Begin While (l^.next<>nil) do Begin Writeln(l^.name);. (* Tìm vị trí cuối *) (* Tìm vị trí đầu *).

(40) l:=l^.next; End; Readln; End; 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); New(s); Clrscr; Writeln('Nhap ban ghi can chen: '); Write('Ten: '); Readln(s^.name); Write('Vi tri can chen: '); Readln(k); End; Procedure Chen_rec; Var i: integer; Procedure Cat(Var L: ptr); Begin s^.next:=l; l:=s; End; Begin p:=l; For i:=3 to k do p:=p^.next; (* Tim vi tri *) If k>1 then Cat(p^.next) Else Cat(l); {Cat - Noi} End; Procedure In_kq;.

(41) Begin While (l^.next<>nil) do Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Chen_rec; In_kq; END. 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; Write('Nhap vi tri 2 ban ghi can doi cho: '); Readln(j,k); End; Procedure Doicho; Var i: integer; Begin p:=l; For i:=2 to k do p:=p^.next; tenk:=p^.name; p:=l; For i:=2 to j do p:=p^.next; tenj:=p^.name; p:=l; For i:=2 to k do p:=p^.next; p^.name:=tenj; p:=l; For i:=2 to j do p:=p^.next; p^.name:=tenk; End;.

(42) Procedure In_kq; Begin While (l^.next<>nil) do Begin Writeln(l^.name); l:=l^.next; End; Readln; End; BEGIN Nhap; Doicho; In_kq; END. ĐỒ HỌA 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,''); 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;.

(43) 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. 3) (* Phạm vi kiểm soát của Con hậu *) Uses Crt,Graph; Const N=8; W=40; X=150; Y=400; Var Gd,Gm,i,Hi: Integer; j,Hj,H: char; S: String; Pattern : FillPatternType; BEGIN Gd:=Detect; InitGraph(Gd,Gm,''); OutTextXY(270,430,'Ban co vua'); For i:=1 to N do For j:='a' to chr(Ord('a')+N-1) do Begin If Odd(i+Ord(j)) then SetFillStyle(SolidFill,14) Else SetFillStyle(SolidFill,15); Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W); End; OutTextXY(200,20,'Nhap vi tri con hau:'); Hj:=ReadKey; OutTextXY(370,20,Hj); H:=ReadKey; Hi:=Ord(H)-Ord('0'); OutTextXY(380,20,H); SetColor(4); Circle(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,W div 2-5); GetFillPattern(Pattern); SetFillPattern(Pattern,4); FloodFill(X+(Hi-1)*W+W div 2,Y-(Ord(Hj)-Ord('a'))*W-W div 2,4); SetFillStyle(SolidFill,13); For i:=1 to N do For j:='a' to chr(Ord('a')+N-1) do If ((i<>Hi)or(j<>Hj)) and((Abs(i-Hi)=Abs(Ord(j)-Ord(Hj)))or(i=Hi)or(j=Hj)) then Bar(X+(i-1)*W,Y-(Ord(j)-Ord('a'))*W,X+i*W,Y-(Ord(j)-Ord('a')+1)*W); Readln; CloseGraph; END. 4) (* Đồng hồ điện tử *) Uses Crt,Dos,Graph; Var h,m,s,hund: Word; GD,GM: Integer;.

(44) St: String; Function LeadingZero(w: Word): String; Var s: String; Begin Str(w:0,s); if Length(s)=1 then s:='0'+s; LeadingZero:=s; End; BEGIN GD:=Detect; InitGraph(GD,GM,' '); SetTextStyle(DefaultFont,HorizDir,5); Repeat GetTime(h,m,s,hund); St:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s); SetColor(15); OutTextXY(150,200,St); Delay(1000); SetColor(0); OutTextXY(150,200,St); Until KeyPressed; CloseGraph; END. 5) (* Điểm chuyển động tròn đều *) Uses Crt, Graph; Const r=150; v=5; Var Gd,Gm,x0,y0,x,y: Integer; a: real; (* góc *) BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); x0:=GetMaxX div 2; y0:=GetMaxY div 2; PutPixel(x0,y0,4); a:=0; Repeat x:=x0+Round(r*cos(a)); y:=y0+Round(r*sin(a)); PutPixel(x,y,15); Delay(v); PutPixel(x,y,0); a:=a+0.01; Until KeyPressed; CloseGraph; END. 6) (* dieu khien vi tri cua hinh vuong *) Uses Crt, Graph; Var Gd,Gm,x,y,v: Integer; Pa,Pb: Pointer; Size: Word; c: char;.

(45) BEGIN Gd:=Detect; InitGraph(Gd,Gm,' '); Size:=ImageSize(0,0,20,20); GetMem(Pb,Size); GetImage(0,0,20,20,Pb^); GetMem(Pa,Size); Bar(0,0,20,20); GetImage(0,0,20,20,Pa^); ClearDevice; x:=300; y:=200; v:=10; c:=#77; Repeat PutImage(x,y,Pa^,NormalPut); Repeat Until KeyPressed; c:=ReadKey; If c=#0 then c:=ReadKey; PutImage(x,y,Pb^,NormalPut); Case c of #72: Dec(y); #75: Dec(x); #77: Inc(x); #80: Inc(y); End; If x>600 then x:=0; If x<0 then x:=600; If y>440 then y:=0; If y<0 then y:=440; Until (c=#27)or(c=#13); CloseGraph; END. 7) (* 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 do Begin ClearDevice; For i:=1 to 4 do Begin Size:=(i-1)*K+1; Inc(Color); Color:=Color mod 15+1; SetColor(Color); SetTextStyle(Font,HorizDir,Size); Str(Size,S); S:='Size '+S; OutTextXY(100,i*80,S) ; End; Readln; End;.

(46) CloseGraph; END. 8) (* Đồ thị của 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 3 do Begin i:=k*E+X0; j:=Y0; Str(k,S); OutTextXY(i-10,j+8,S); Bar(i-1,j-1,i+1,j+1); End; Line(X0,50,X0,370); {Truc Oy} OutTextXY(X0-20,50,'y'); For k:=-1 to 4 do Begin i:=X0; j:=-k*E+Y0; Str(k,S); If k<>0 then OutTextXY(i-20,j,S); Bar(i-1,j-1,i+1,j+1); End; For i:=X0-2*E to X0+2*E do {Do thi} Begin x:=(i-X0)/E; y:=Sqr(x); j:=Round(-y*E+Y0); PutPixel(i,j,10); End; SetTextStyle(1,0,2); OutTextXY(100,400,'Do thi ham so y = Sqr(x):'); Readln; CloseGraph; END. 9) (* 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);.

(47) Rectangle(330,230,390,280); MoveTo(220,200); Lineto(180,200); Lineto(220,140); Lineto(420,140); Lineto(460,200); Lineto(420,200); SetFillPattern(Pattern,Blue); Floodfill(0,0,White); SetFillPattern(Pattern,4); Floodfill(320,190,White); SetFillPattern(Pattern,8); Floodfill(320,220,White); Repeat Repeat c:=ReadKey; Until c in [#27,'+','-']; If (c='+') then SetFillPattern(Pattern,14) Else If (c='-') then SetFillPattern(Pattern,0);; Floodfill(270,300,White); Floodfill(370,270,White); Until c=#27; CloseGraph; END..

(48)

giao an boi duong hoc sinh gioi tin hoc 20162017

Tài liệu liên quan

Tài liệu bạn tìm kiếm đã sẵn sàng tải về