Sưu tầm các bài pascal cơ bản ở tailieuit.

I. Bài Tập Tính Toán Cơ Bản

1. Giải PT bậc 1 (ax+b=0)
PHP Code:
PROGRAM NCK;
VAR A,B:REAL;
BEGIN
WRITELN('NHAP A, B: ');
READLN(A,B);
IF (A=0) AND (B<=0) THEN WRITELN('VO NGHIEM');
IF (A=0) AND (B>0) THEN WRITELN('X THUO^.C R');
IF A<0 THEN WRITELN('NGHIEM: X<',-B/A:0:2);
IF A>0 THEN WRITELN('NGHIEM: X>',-B/A:0:2);
READLN;
END.
2.ĐỔI SỐ THÀNH CHỮ (VD: A --> TWO)
PHP Code:
PROGRAM NCK;
VAR N:BYTE;
BEGIN
WRITELN('NHAP N: ');
READLN(N);
IF N=1 THEN WRITE('1 = ONE');
IF N=2 THEN WRITE('2 = TWO');
IF N=3 THEN WRITE('3 = THREE');
IF N=4 THEN WRITE('4 = FOUR');
IF N=5 THEN WRITE('5 = FIVE');
READLN;
END.


Bài 3: Giải hệ phương trình bậc 1 - 2 ẩn số
PHP Code:
PROGRAM NCK;
VAR A1, B1, C1, A2, B2, C2:INTEGER;
DX, DY ,DD : REAL;
BEGIN
WRITELN('NHAP HE SO A1, B1, C1: ');
READLN(A1, B1, C1);
WRITELN('NHAP HE SO A2, B2, C2: ');
READLN(A2, B2, C2);
DD := A1*B2-A2*B1;
DX := C1*B2-C2*B1;
DY := A1*C2-A2*C1;
IF DD = 0 THEN
IF (DX=0) AND (DY=0 ) THEN
WRITE('HPT VSN')
ELSE WRITE('HPT VN')
ELSE
BEGIN
WRITELN('HPT CO NGHIEM: ');
WRITELN('X = ', DX/DD:2:2);
WRITELN('Y = ', DY/DD:2:2);
END;
READLN;
END.


Bài 4: Nhập tọa độ 3 điểm và xét tan giác
PHP Code:
PROGRAM NCK;
VAR XA, YA, XB, YB, XC, YC, AB, BC, AC, S, P: REAL;
BEGIN
WRITELN('NHAP TOA DO DIEM A(XA,YA): ');
READLN(XA,YA);
WRITELN('NHAP TOA DO DIEM B(XB,YB): ');
READLN(XB,YB);
WRITELN('NHAP TOA DO DIEM C(XC,YC): ');
READLN(XC,YC);
AB:=SQRT(SQR(XB-XA)+SQR(YB-YA));
BC:=SQRT(SQR(XC-XB)+SQR(YC-YB));
AC:=SQRT(SQR(XC-XA)+SQR(YC-YA));
IF (AB=0) OR (BC=0) OR (AC=0) OR (AB+AC=BC) OR (AB+BC=AC) OR (AC+BC=AB) THEN
WRITELN('KHONG PHAI LA 3 DINH CUA TAM GIAC')
ELSE
BEGIN
WRITELN('LA 3 DINH CUA TAM GIAC');
IF (AB=BC) AND (AB=AC) THEN WRITELN('LA TAM GIAC DEU');
IF (AB=BC) OR (AB=AC) OR (BC=AC) THEN WRITELN('LA TAM GIAC CAN');
IF (SQR(AB)+SQR(AC)=SQR(BC)) OR (SQR(AB)+SQR(BC)=SQR(AC)) OR (SQR(BC)+SQR(AC)=SQR(AB)) THEN
WRITELN('LA TAM GIAC VUONG');
P:=(AB+AC+BC)/2;
S:=SQRT(P*(P-AB)*(P-AC)*(P-BC));
WRITELN('DIEN TICH CUA TAM GIAC LA:',S:0:2);
END;
READLN;
END.
Bài 5: Bài toán Gà - Chó
PHP Code:
PROGRAM NCK;
VAR G,C:REAL;
BEGIN
X+Y=36;
2X+4Y=100;
G:=0;
C:=0;
WHILE G<36 DO
BEGIN
C:=36-G;
IF 2*G+4*C=100 THEN WRITELN('SO GA LA: ',G,' SO CHO LA: ',C);
G:=G+1;
END;
READLN;
END.



Bài 6: Giải Phương Trình Bậc 2 Ax.x + bx + c =0
PHP Code:
PROGRAM G_PTB2; {AX*X+BX+C=0}
USES CRT;
VAR A, B, C: INTEGER;
D, X1, X2: REAL;
BEGIN
CLRSCR;
WRITELN('** GIAI PHUONG TRINH BAC 2 **');
WRITELN('NHAP HE SO A, B, C: ');
READLN(A, B, C);
D:=SQR(B)-4*A*C;
IF D=0 THEN
WRITE('PT CO NGHIEM KEP X = ',-B/2*A:2:2)
ELSE
IF D>0 THEN
BEGIN
X1:=(-B+SQRT(D))/(2*A);
X2:=(-B-SQRT(D))/(2*A);
WRITELN('PT CO 2 NGHIEM: ');
WRITELN('X1 = ', X1:2:2);
WRITELN('X2 = ', X2:2:2);
END
ELSE WRITE('PT VN');
READLN;
END.
Bài 7: Nhập mảng gồm n phần tử. Tìm số lớn nhất và số nhỏ nhất trong mảng
PHP Code:
PROGRAM NCK; {MS: 639}
USES CRT;
VAR A: ARRAY[1..100] OF INTEGER;
I, N, LN, NN: INTEGER;
BEGIN
CLRSCR;
WRITELN('** CHUONG TRINH NCK **');

WRITE('NHAP N PHAN TU: ');
READLN(N);
FOR I:=1 TO N DO
BEGIN
WRITE('A[',I,']=');
READLN(A[I]);
END;
LN:=A[1]; NN:=A[1];
FOR I:=1 TO N DO
BEGIN
IF A[I]>LN THEN LN:=A[I];
IF A[I]<NN THEN NN:=A[I];
END;
WRITELN('MAX: ', LN, ' MIN: ',NN);
READLN
END.

II. Phần chuyên sâu

1. Giải bài toán FIBONACI - Khử đệ quy (không dùng đệ quy)
PHP Code:
program fibonaci;
uses crt;
var a:array [1..100] of integer;

n,i,m,d,s:integer;

procedure fibonaci;
begin

if n=1 then a[1]:=1
else begin

i:=2;s:=1;a[1]:=1;

repeat

a[i]:=s;

i:=i+1;

s:=a[i-1]+a[i-2];



until i>n;

end;

write(' Day so fibonaci la:');

for i:=1 to n do

write(' ',a[i]);

writeln;

end;

begin

clrscr;

write(' Nhap so de tinh day fibonaci:');readln(n);

write(' Nhap so de kiem tra xem co trong day fibonaci khong:');readln(m);

fibonaci;

d:=0;

for i:=1 to n do

if a[i]=m then d:=d+1;

if d=1 then writeln(' So de kiem tra co mat trong day fibonaci')

else writeln(' So kiem tra khong co mat trong day fibonaci');

readln;

end.
-----------------------------------------------------------


2. Số Hoàn Hảo: là số có tổng các ước của nó (trừ nó) bằng chính nó
Ví dụ : 6 = 1 + 2 + 3
Nội dung :
-viết chương trình kiểm tra xem 1 số có là số hoàn hảo không

-liệt kê tất cả số hoàn hảo từ 1..2000 và đếm xem có bao nhiu số

PHP Code:
program hoanhao;

uses crt;

var n,i,d,k,j:integer;

procedure hoanhao;

begin

d:=0;

for i:=1 to n-1 do

if n mod i=0 then d:=d+i;

if d=n then writeln(' So vua nhap la so hoan hao')

else writeln(' So vua nhap khong la so hoan hao');

end;

procedure vietlen;

begin

write(' Day so hoan hao tu 1-->2000:');

k:=0;

for i:=1 to 2000 do

begin

d:=0;

for j:=1 to i-1 do

if i mod j=0 then d:=d+j;

if d=i then begin

write(' ',i);

k:=k+1;

end;

end;

writeln;

writeln(' Trong day 1-->2000 co ',k,' so hoan hao');

end;

begin

clrscr;

write(' Nhap n=');readln(n);

hoanhao;

vietlen;

readln;

end.
-----------------------------------------------------------


3. Tổng hợp - Nhập vào 1 số nguyên gồm 4 chữ số

-Kiểm tra tình chắn lể
-kiểm tra xem có phải là số nguyên tố không
-kiểm tra xem có phải là số chính phương không

PHP Code:
program chuong_trinh;

uses crt;

var i,n,k,d:integer;

ok:boolean;

function chanle(n:integer):boolean;

begin

ok:=true;

if n mod 2<>0 then ok:=false;

chanle:=ok;

end;

function nguyento(n:integer):boolean;

begin

ok:=true;

d:=0;

for i:=1 to n-1 do

if n mod i=0 then d:=d+1;

if d<>1 then ok:=false;

nguyento:=ok;

end;

function chinhphuong(n:integer):boolean;

begin

ok:=true;

k:=trunc(sqrt(n));

if sqr(k)<>n then ok:=false;

chinhphuong:=ok;

end;

begin

clrscr;

write(' Nhap n=');readln(n);

if chanle(n) then writeln(' So vua nhap la chan')

else writeln(' So vua nhap la so le');

if nguyento(n) then writeln(' So vua nhap la nguyen to')

else writeln(' So vua nhap khong phai la so nguyen to');

if chinhphuong(n) then writeln(' So vua nhap la so chinh phuong')

else writeln(' So vua nhap khong la so chinh phuong');

readln;

end.
-----------------------------------------------------------


4. Viết chương trình thược hiện các việc sau

a) Tạo 2 file F1 F2 là những file text để ghi dữ liệu từ bàn phím
b) Nối file F2 vào cuối File F1 và tính độ dài File F1
c) Đưa nội dung File F1 ra màn hình và đếm xem trong file này có bao nhiêu từ 'May mắn'

PHP Code:
program hahuy;
uses crt;
const input='input.txt';
output='output.txt';

var f1,f2: text;
st1,st2,key:string;
dem,vt: integer;
begin
clrscr;
assign(f1,input); rewrite(f1);
assign(f2,output); rewrite(f2);
writeln('nhap xau 1'); readln(st1); write(f1,st1); close(f1);
writeln('nhap xau 2'); readln(st2); write(f2,st2); close(f2);

st1:=st1 + st2;
writeln('do dai xau s1 = ',length(st1) );
writeln(st1);

dem:=0;
key:='may man';
vt:=pos(key,st1);
while vt<>0 do
begin
delete(st1,vt,length(key));
dem:=dem+1;
vt:=pos(key,st1);
end;
writeln('tu khoa ',key,' xuat hien ',dem,' lan');
write(' HAHUY_NO1VN ');
readln;
end.
----------------------------------------------------------


5. Tính Giai Thừa
PHP Code:
Program giaithua;
uses crt;
var a: integerl=;
Function gt(n:byte):Longint;
Var
s:Longint;
i:byte;
Begin
s:=1
For i:=2 to n do
s:=s*i;
gt:=s;
End;
Begin
clrscr;
write ('Nhap so can tinh giai thua: ');readln(a);
if a:=0 or a:=1 then
writeln('Giai thua cua ',a,' = 1')
else
writeln('Giai thua cua',a ,' =', giaithua(a) );
End.
--------------------------------------------------

Bài 6 - Nhập vào 1 mảng gồm n số nguyên (2<n<20). In ra các số nguyên tố có trong mảng


PHP Code:
program Mang;
uses crt;
var a:array [ 1..20] of byte;
i,n,d,j,k:integer;

procedure nhap;
begin
for i:=1 to n do
begin
write(' a[',i,']=');readln(a[i]);
end;
end;

procedure nguyento;
begin
write(' Day so cac so nguyen to:');
k:=0;
for i:=1 to n do
begin
d:=0;
for j:=1 to a[i]-1 do
if a[i] mod j=0 then
d:=d+1;
if d=1 then
begin
write(' ',a[i]);
k:=k+1;
end;
end;
if k=0 then
write(' khong co so nao')
else
begin
writeln;
writeln(' Trong day co ',k,' so nguyen to');
end;
end;

begin
clrscr;
repeat
write(' Nhap n=');readln(n);
until (2<n)and(n<20);

nhap;
nguyento;
readln;
end.
------------------------------------------------------

Bài 7 Nhập vào 1 mảng gồm n số nguyên (2<n<20)

-tìm số lớn nhất và vị trí của nó
-sắp xếp mảng t[color:9c6d=rgb(0, 0, 0)]ăng dần theo giá trị
-hiển thị mảng vừa sắp xếp

PHP Code:
program mang2;
uses crt;
var a:array [1..20] of integer;
b:array [1..20] of integer;
i,n,max,j,tg:integer;

procedure nhap;
begin
for i:=1 to n do
begin
write(' a[',i,']=');readln(a[i]);
end;

end;

procedure timmax;
begin
max:=a[1];
for i:=2 to n do
if a[i]>max then
max:=a[i];

j:=1;
for i:=1 to n do
if a[i]=max then
begin
b[j]:=i;
j:=j+1;
end;
write(' So lon nhat trong day la ',max,' o vi tri thu');

for i:=1 to j-1 do
write(', ',b[i]);
writeln;
end;

procedure tang;
begin
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;
write(' Day duoc sap xep lai la:');
for i:=1 to n do
write(' ',a[i]);
end;

begin
clrscr;
repeat
write(' Nhap n=');readln(n);
until (2<n)and(n<20);
nhap;
timmax;
tang;
readln;

end.

Nhập vào một xâu. Viết mỗi từ trong xau trên mỗi dòng.
program nguyennham.1012;
uses crt;
var st:string;
procedure ex(ab:string);
var
i:integer;
begin
i:=1;
while (length(ab) <> 0) do
if (ab[i]<>' ') and ((ab[i+1] = ' ') or (ab[i+1] = '.')) then {Tu them dieu kien de chinh xac hon. vd ';',':'... }
begin
writeln(copy(ab,1,i+1));
delete(ab,1,i+1);
i :=1;
continue;
end else inc(i);
end;
begin
clrscr;
writeln('nhap xau:'); readln(st);
ex(st);
Writeln('nguyennham.1012');
readln;
end.