Những bài tập pascal hay

Bài tập pascal 11
Bài tập 1:Nhập ba số bất kỳ kiểm tra ba số vừa nhập có phải là ba cạnh của tam giác hay không?
Var
a , b , c : Real ;
BEGIN
Writeln (' Nhap do dai 3 so bat ky : ') ;
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 tập 2: Nhập vào N số cho trước đếm có bao nhiêu phần tử nằm trong khoảng 10 đến 20
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 tập 3: Tìm giá trị lớn nhất, nhỏ nhất trong 4 số nhập từ bàn phím
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 ;
Min:=a;
If Min > b Then Min := b ;
If Min > c Then Min := c ;
If Min>d Then Min := d ;
Writeln (' Gia tri lon nhat la : ', Max ) ;
Writeln (' Gia tri nho nhat la : ', Min ) ;
Readln ;
END .
Bài tập 4: Nhập ngày tháng bất kỳ chương trình tìm ngày trong tuần của ngày vừa nhập
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 ('Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Chu Nhat ') ;
1 : Writeln (''Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Hai ') ;
2 : Writeln (''Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Ba ') ;
3 : Writeln (' 'Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Tu ') ;
4 : Writeln (' 'Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Nam ') ;
5 : Writeln (' 'Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Sau ') ;
6 : Writeln (' 'Ngay ‘,Ngay, ‘thang’, thang, ‘nam’ ,nam,‘la ngay Thu Bay ') ;
End ;
Readln ;
END.
Bài tập 5: chương trình nhập điểm văn, toán, ngoại nữ của học sinh, chương trình in ra màn hình
giấy báo nếu tổng điểm lớn hơn 15 thì trúng tuyển, nếu không thì ghi không trúng tuyển
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.
Bài tập 6: Nhập hai số a,b cho trước, nhập phép tính cuẩ và b,các phép tính cộng, trừ, nhân,chia
Hiển thị lên màn hình kết quả của phép tính đó
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 tập 7: Chương trình giải phương trình bậc 2
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 tập 8: Chương trình nhập từ bàn phím các ký tự chương trình đếm số lần xuất hiện của mỗi ký

tự
Uses Crt ;
Var a : Array[ 'A'..'Z' ] of integer;
ch : char ;
i : byte ;
BEGIN
Clrscr ;
For ch :='A' to 'Z' Do a[ch] := 0 ;
Writeln (' Go phim 50 lan ') ;
For i := 1 To 50 Do
Begin
ch :=Readkey ;
ch := Upcase(ch) ;
a[ch] := a[ch] + 1 ;
End;
Writeln (' So lan xuat hien cac ki tu la :') ;
For ch :='A' to 'Z' do
If a[ch] > 0 Then
Writeln (ch , a[ch] : 4 , ' lan . ');
Readln ;
END.
Bài tập 9: Chương tình tính tổng S:=1+1/1+1/2+1/3+1/4+1/5+….1/n
Uses Crt ;
Var i , n : Integer ;
tong: Real ;
BEGIN
Clrscr ;
Write (' Cho so tu nhien n : ') ; Readln (n) ;
tong :=0 ;
i :=1 ;

While i <= n Do
Begin
tong := tong + 1/i ;
i := i + 1 ;
End ;
Writeln (' Tong can tim la : ', tong:12:6 ) ;
Readln ;
END.
Bài tập 10: Bài toán tính a mũ n
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.
Bài tập 11 : Sắp xếp các phần tử trong mảng cho trước
uses crt;
var a: array[1..100] of integer;
var i,n,j, tg,max, vt : integer;

begin
clrscr;
write(' nhap so phan tu cua mang ');
readln(n);
writeln(' moi nhap cac phan tu cua mang ');
for i:= 1 to n do
begin
write('A', i,']= ');
readln(a[i]);
end;
Max:=a[1]; vt:=1;
For i:=1 to n do
begin
If A[i]>max then
Begin
Max:=a[i]; vt:=i;
End;
end;
Writeln('gia tri lon nhat la ', max, ' nam o vi tri thu ' ,vt);
for i:= 1 to n-1 do
for j:=i+1 to n do
if a[i]>a[j] then
begin
tg:=a[i];
a[i]:=a[j];
a[j]:=tg;
end;
writeln(' day sau khi sap xep la ');
for i:=1 to n do
write(' ', a[i]);

readln;
end.
Bài tập 12: Nhập xâu cho trước kiểm tra có phải xâu đối xứng hay không?
Uses Crt;
Var St : string;
dx : Boolean;
i, len: byte;
BEGIN
Clrscr;
Write(' Nhap xau St = '); Readln(St);
dx:= True;
i:=1;
len:= Length(St);
While dx and (i<=(len div 2)) do
Begin
dx:=(St[i] = St[len - i+1]);
inc(i);
End;
If dx then Write(' St la xau doi xung ')
Else Write(' St khong phai la xau doi xung ') ;
Readln;
END.
Bài tập 13: Chương trình nhập vào họ tên của một người sau đó xóa hết ký tự trắng dư thừa
Uses crt;
Const Chu=['a'..'z'];
Var Hoten: string;
i,len: byte;
BEGIN
Clrscr;
Write('Ho ten='); Readln(Hoten);

Len:=length(Hoten);
If Hoten[1] in Chu then Hoten[1]:=Upcase(Hoten[1]);
For i:=2 to len do
If (Hoten[i-1]=#32)and(Hoten[i] in Chu) then
Hoten[i]:=Upcase(Hoten[i]);
Write('Ho ten sau khi dieu chinh la: ', Hoten);
Readln;
END.
Bài tập 14: Chương trình nhập tệp tin và tính số phần tử tệp vừa nhập
Uses Crt;
Type Tap=set of 0..99;
Const inp='Number.dat';
Var S : Tap;
i : byte;
Procedure Nhap;
Var a: byte; f: text;
Begin
S:=[];
Assign(f,inp); Reset(f);
While not SeekEoF(f) do
begin
Readln(f,a); If (a>=0)and(a<=99) then S:=S+[a];
End;
Close(f);
End;
Function Card(S: Tap): byte;