BT và giải BT Pascal

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 .
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 .
Var
Max , a , b , c , d : Real ;
BEGIN
Writeln (' Nhap gia tri cua 4 so : ') ;
Write (' a = ') ; Readln ( a ) ;
Write (' b = ') ; Readln ( b ) ;
Write (' c = ') ; Readln ( c ) ;
Write (' d = ') ; Readln ( d ) ;
Max := a ;
If Max < b Then Max := b ;
If Max < c Then Max := c ;
If Max < d Then Max := d ;
Writeln (' Gia tri lon nhat la : ', Max ) ;
Readln ;
END .
Var
Thu , Ngay , Thang : Byte ;
Nam : Integer ;
BEGIN
Write (' Doc Ngay Thang Nam : ') ;
Readln ( Ngay , Thang , Nam ) ;
Nam := 1900 + ( Nam mod 1900 ) ;
If Thang < 3 Then
Begin
Thang := Thang + 12 ;
Nam := Nam - 1 ;
End ;
Thu := Abs ( Ngay + Thang * 2 + ( Thang + 1 ) * 3

div 5 + Nam + Nam div 4 ) mod 7 ;
Case Thu Of
0 : Writeln (' Chu Nhat ') ;
1 : Writeln (' Thu Hai ') ;
2 : Writeln (' Thu Ba ') ;
3 : Writeln (' Thu Tu ') ;
4 : Writeln (' Thu Nam ') ;
5 : Writeln (' Thu Sau ') ;
6 : Writeln (' Thu Bay ') ;
End ;
Readln ;
END .
Uses Crt ;
Var SBD : Integer;
Van , Toan , Ngoaingu , Tongdiem : Real ;
BEGIN
Clrscr ;
Write (' So bao danh : ') ; Readln( SBD ) ;
Write (' Diem toan : ') ; Readln( Toan ) ;
Write (' Diem ngoai ngu : ') ; Readln( Ngoaingu ) ;
Write (' Diem van : ') ; Readln ( Van ) ;
Tongdiem := Toan + Van + Ngoaingu ;
Clrscr ;
Writeln (' Phieu Bao Diem ') ;
Writeln (' So bao danh : ', SBD ) ;
Writeln (' Diem van : ', Van ) ;
Writeln (' Diem toan : ', Toan ) ;
Writeln (' Diem ngoai ngu : ', Ngoaingu) ;
Writeln (' Tong diem : ', Tongdiem) ;
If Tongdiem >= 15 Then

Writeln(' Ban da trung tuyen ')
Else
Writeln(' Ban khong trung tuyen ') ;
Readln ;
END .
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 .
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 .
Uses Crt ;
Var
N , M : Integer ;
Begin
Clrscr ;
Write(' N , M = ') ; Readln( N , M ) ;
If ( (N + M) mod 2 = 0 ) Then Writeln(' Dung ! ')
Else Writeln(' Sai ! ') ;
Readln ;
END .
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 .
Uses Crt ;
Var a : Array[ 'A'..'Z' ] of integer; (* mảng bộ đếm *)
ch : char ; (* biến nhập kí tựù *)
i : byte ; (* chỉ số của lần gõ phím *)
BEGIN
Clrscr ;
For ch :='A' to 'Z' Do a[ch] := 0 ; (* xả bộ đếm *)
Writeln (' Go phim 50 lan ') ;
For i := 1 To 50 Do (* thực hiện 100 lần *)
Begin
ch :=Readkey ; (* nhập kí tự vào Ch không cần gõ Enter *)
ch := Upcase(ch) ; (* Đỗi chữ thường thành chữ hoa *)
a[ch] := a[ch] + 1 ;
End;
Writeln (' So lan xuat hien cac ki tu la :') ;
For ch :='A' to 'Z' do (* Kiểm tra bộ đếm từ 'A' tới 'Z' *)
If a[ch] > 0 Then (* Nếu Ch có xuất hiện *)
Writeln (ch , a[ch] : 4 , ' lan . ') ; (* Viết ra màn hình kí tự và
số lần xuất hiện *)
Readln ;
END .
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 .
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 .

Uses Crt ;
Var i , n : Integer ;
tong: Real ;
BEGIN
Clrscr ;
Write (' Cho so tu nhien n : ') ; Readln (n) ;
tong :=0 ;
i :=1 ;
While i <= n Do
Begin
tong := tong + 1/i ;
i := i + 1 ;
End ;
Writeln (' Tong can tim la : ', tong:12:6 ) ;
Readln ;
END .
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 .
Uses Crt;
Var A : Array [1..100] Of Integer;
i , j , n : Integer ;
BEGIN
Clrscr ;
Write(' Do dai cua day so N = ') ; Readln (N) ;
For I := 1 To N Do
Begin
Write ('A[', i , ']= ') ; Readln ( A[i] ) ;
End ;
Writeln (' Cac so khac nhau la : ') ; Writeln ( A[1] ) ;
i := 2 ;
While i <= N Do
Begin
j := 1 ;
While ( j < i ) and ( A[j] <> A[i] ) Do inc(j) ;
If j = i Then Writeln( A[i] ) ;
i :=i + 1 ;
End ;
Readln ;
END .
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 .
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 .
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 .
uses crt ;
var
thang : Byte ;
tien , lai , x : Real ;
BEGIN
clrscr ;
writeln (' Chuong trinh tinh thoi gian rut tien lai ') ;
write (' So tien lai muon rut ra : ') ; readln(x) ;
tien := 1000 ;
thang :=1 ;
repeat
lai := tien * 8 / 100 ;
tien := tien + lai ;
thang := thang + 1 ;
until tien >= x ;
writeln (' Ban phai gui tien trong ', thang div 12 , ' nam ',
thang mod 12 ,' thang .') ;
writeln (' Khi do so tien ban rut ra duoc la ', tien:12:2 ,' dong .') ;
readln ;
END .
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 .
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 ;
Uses Crt ;
Var a, b, c, x1, x2: real;
(*================================*)
Procedure Nhapabc(var aa,bb,cc: real);
Begin
Write('a='); Readln(aa);
Write('b='); Readln(bb);
Write('c='); Readln(cc);
End;
(*=================================*)
Procedure GPTB2;
Var Delta: real;
Begin
Delta:=sqr(b)-4*a*c;
If Delta<0 then Writeln('Phuong trinh vo nghiem.')
Else
If Delta=0 then
Begin
Write('Phuong trinh co nghiem kep : ');
Write('x1,2=',-b/(2*a):8:2);
End
Else
Begin
x1:=(-b+sqrt(Delta))/(2*a);

x2:=(-b-sqrt(Delta))/(2*a);
Writeln('Phuong trinh co 2 nghiem phan biet la :');
Writeln('X1=',x1:8:2, 'X2=',x2:8:2);
End;
End;
(*================================*)
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 .
Procedure Insert ( St1 : String ; Var St2 : String ;Vt : Byte ) ;
(* chèn xâu St1 vào St2 bắt đầu từ vò trí Vt *)
Var i : Byte ;
S : String ;
Begin
If ( Vt > length(St2) Or ( Vt < 1 ) Then
Write(' Khong the chen ra ngoai xau ') ;
Else
Begin
S := '' ; (* xâu rỗng *)
For i := 1 To (Vt - 1) Do S := S + St2[i] ;
S := S + St1 ;
For i := Vt To length(St2) Do S := S + St2[i] ;
St2 := S ;
End ;
End ;

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 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 .
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.
Uses Crt;
Var N, a, b, c, X, Y, Z, i: Integer;
Begin
Clrscr;
Write(' N, a, b, c = '); Readln(N, a, b,c);
If (a+b+c-3<N) then
Begin
Writeln('Phuong trinh vo nghiem'); Readln;
Exit;
End
Else
Begin
Writeln('Phuong trinh co nghiem la:');
Writeln('x': 10, 'y': 10, 'z':10);
i:=4;
For X:=0 to (a-1) do
For Y:=0 to (b-1) do
For Z:=0 to (c-1) do
If (X+Y+Z=N) then
Begin
Writeln(x: 10, y: 10, z: 10);
inc(i);
If i=24 then
Begin
Write('Nhan Enter de tiep tuc...'); Readln;
i :=0;
End;