Gần đền kỳ thi học sinh giỏi cấp TP. Mình xin gửi 1 số bài tập pascal để các bạn tiện theo dõi.
PROGRAM VIDU11_3;
{ In đảo ngược các chữ số của N }
Var
N, k: LongInt ;
Begin
Repeat
Write(' Nhap N : ');
Readln(N);
Until (N>0);
Writeln( N, ' duoc in dao nguoc thanh :');
Repeat
k:= N mod 10;
Write(k: 3);
N:=N div 10;
Until N=0;
Readln;
End.

-------------------------------------------------------
PROGRAM VIDU11_13 ;
{ Tính tổng các bình phương các chữ số của số N}
Var
N, T : Longint;
i, j , k : Integer;
St : String[40];
Begin
Write('Nhập số N : '); Readln(N);
Str( N, St );
T:=0;
For i:=1 to Length(St) do
begin
Val ( St[i], j, k );
T:=T+ j*j;
end;
Writeln(' Tong= ', T);
Readln;
End.
-------------------------------------------------------
PROGRAM VID12_1; Tính căn bậc 3 của một số bất kỳ
Var
x : Array[1..20] of Real;
S : Real;
N, i : integer;

FUNCTION Canba( z: Real) :Real;
{ Hàm tính căn bậc ba của z}
Var
F: Real;
Begin
If z=0 then F:= 0;
If z>0 then F:= exp( 1/3*Ln(z) );
If z<0 then F:= - exp( 1/3*Ln(-z) );
Canba:=F ;
End;

BEGIN { vào chương trình chính}
Repeat
Write(' nhap N: ');
Readln(N);
Until ( N>0) and ( N<21);
S:=0;
For i:=1 to N do
begin
Write('nhap x[', i, ']:');
Readln(x[i]);
S:=S + Canba( x[i] );
end;
Writeln(' S= ', S:8:2);
Readln;
END.


-------------------------------------------------------
PROGRAM VIDU12_2;
Var
St : String;
N, i : integer;
FUNCTION Chuthuong( ch: Char):Char;
{ Hàm đổi chữ hoa ra chữ thường}
Var
C: Char;
Begin
If ( ch>='A' ) and ( ch<='Z') then C:=Chr( ord(ch)+32 )
else
C:=ch;
Chuthuong:=C;
End;

BEGIN { vào chương trình chính}
Write(' Nhap chuoi chu hoa St : ');
Readln(St);
N:=Length(St);
For i:=1 to N do St[i]:=Chuthuong( St[i] );
Writeln(' St = ', St);
Readln;
END.
-------------------------------------------------------
PROGRAM VIDU12_4;
{ Giải phương trình AX+B=0 bằng thủ tục}
Uses Crt;
Var
i, j: integer;

Procedure Giaipt (a, b: Real);
Begin
Writeln('-Giai p.trinh : ' , a:4:1, 'x+' , b:4:1, '=0');
If a<>0 then Writeln(' Nghiem x=', -b/a:4:2)
else
if b<>0 then Writeln(' Vo nghiem')
else
Writeln(' Vo so nghiem');
End;

BEGIN
Clrscr;
Writeln('KET QUA GIAI CAC P.TRINH NHU SAU:');
Giaipt (4.5, 13.5);
For i:=-1 to 1 do
For j:=0 to 2 do Giaipt (i, j);
Readln;
END.
-------------------------------------------------------
PROGRAM VIDU13_2;
{ Tính diện tích S và chu vi L của HCN theo 2 cạnh a, b}
Var
a,b, S, L: Real;
Procedure TINH( c1, c2: Real ; Var DT, CV: Real);
{ Thủ tục tính diện tích DT va chu vi CV theo hai cạnh c1 và c2}
Begin
DT:=c1*c2;
CV:=2*(c1+ c2);
End;
BEGIN
Write(' Nhap hai canh a, b: ');
Readln(a,b);
TINH(a, b, S, L);
Writeln('Dien t¡ch= ', S:4:1);
Writeln('Chu vi = ', L:4:1);
Readln;
END.
-------------------------------------------------------
PROGRAM VIDU13_7;
{ Tính N! bằng đệ qui}
Var
N : Byte;
Function Gt( k : Byte) : Real;
{ Hàm tính k! bằng đệ qui}
Begin
If k=0 then Gt:= 1
else
Gt:= k* Gt(k-1);
End;
BEGIN
Repeat
Write(' Nhap N: ');
Readln(N);
Until N>0;
Writeln( N, ' != ', Gt(N):0:0 );
Readln;
END.
-------------------------------------------------------
PROGRAM VIDU13_8;
{ Tính số Fibonaci thứ N }
Var
N : Integer;
Function Fibo( k : Integer) : Integer;
{ Ham tinh so Fibonaci thu k bang de qui}
Begin
If k=0 then Fibo:= 1
else
if k=1 then Fibo:=1
else
Fibo:=Fibo(k-1) + Fibo( k-2);
End;
BEGIN
Write(' Nhap N: ');
Readln(N);
Writeln( ' So Fibo thu ', N, ' = ', Fibo(N) );
Readln;
END.

-------------------------------------------------------
PROGRAM VIDU61;
{ Đổi tiền }
Var
N, st5, st2, st1, sodu : LongInt;
Begin
Write(' Nhap so tien : '); Readln(N);
st5 := N div 5;
Sodu := N mod 5;
st2 := Sodu div 2;
st1 := Sodu mod 2;
Writeln(' KET QUA DOI TIEN LA :');
Writeln(' So to 5d = ', st5);
Writeln(' So to 2d = ', st2);
Writeln(' So to 1d = ', st1);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU62; {kiểm tra số chẵn lẻ}
Var
N : Integer;
Begin
Write('Nhap so N :'); Readln(N);
If Odd(N) = TRUE then write(N, ' La so le')
else
write(N, ' La so chan');
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU64 ; Tìm mã ký tự phím gõ
Uses CRT;
Var
k : Byte;
Begin
CLRSCR;
Writeln('Nhap so 0 de ket thuc chuong trinh !');
Repeat
Write(' Nhap ma cua ky tu : '); Readln(k);
Writeln(' Ky tu co ma ', k, ' la ' , Chr(k) );
Until k=0;
End.
-------------------------------------------------------
PROGRAM VIDU65; đổi chữ hoa thành thường và chữ thường thành hoa
Var
ch, ch1 : Char;
Begin
Write(' Nhap mot ky tu :'); Readln(ch);
If (ch>='A') and ( ch<='Z') then ch1:=Chr( Ord (ch)+32)
else
ch1:= Upcase(ch);
Writeln( ch, ' doi thanh ' , ch1);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU66;
{Tính diện tích và chu vi tam giác theo 3 cạnh}
Var
a, b, c, P, S : Real;
Tgiac: Boolean;
Begin
Write(' Nhap 3 canh cua tam giac : ');
Readln(a, b, c);
Tgiac:= (a>0) and (b>0) and (c>0) and
(a+b>c) and (a+c>b) and (b+c>a);
If Tgiac= FALSE then
Writeln(' Khong phai ba canh cua tam giac !')
else
begin
P:=(a+b+c)/2;
S:= Sqrt( P*(P-a)*(P-b)*(P-c) );
Writeln(' chu vi = ' , 2*P:10:2);
Writeln(' dien tich = ' , S:10:2);
end;
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU81;
{ Tìm Max của hai số }
Var
a, b, max : Real;
Begin
Write(' Nhap a va b :');
Readln(a,b);
Max :=a ;
If Max < b then Max:=b ;
Writeln(' So lon nhat la: ' , Max:6:2);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU82;
{ Phân loại sinh viên }
Var
Ho_ten: String[18];
DTB: Real;
Loai: String[6];
Begin
Write('Nhap ho va ten :');
Readln(Ho_ten);
Write('Nhap diem trung binh :');
Readln(DTB);
{ phan loai theo DTB }
If DTB< 5 then Loai:='Kem';
If (DTB>= 5) and (DTB<7) then Loai:='Tbinh';
If (DTB >= 7) and (DTB< 9) then Loai:='Kha';
If DTB >= 9 then Loai:='Gioi';
Writeln(Ho_ten, #32 , DTB:4:1 , #32 , Loai);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU83;
{ Giải phương trình bậc 2 với hệ số a khác 0 }
Var
A, B, C, Delta, X1, X2 : Real;
Begin
Repeat
Write( ' Nhap he so A khac khong :');
Readln(A);
Until A<>0;
Write( ' Nhap cac he so B, C: ');
Readln(B, C);
Delta:=B*B - 4*A* C;
If Delta < 0 then Writeln( ' Ptrinh vo nghiem ! ');
If Delta = 0 then
begin
X1:=-B/(2*A);
Writeln(' Co ng. kep X1=X2 = ' , X1:8:2);
end;
If Delta > 0 then
begin
X1 := (-B+ Sqrt(Delta) ) / (2*A);
X2 := (-B - Sqrt(Delta) ) / (2*A);
Writeln('Co hai nghiem :');
Writeln('X1= ' , X1:8:2);
Writeln('X2= ' , X2:8:2);
end;
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU86;
{ Tính căn bậc ba của x }
Var
x, y : Real;
Begin
Write(' Nhap x :');
Readln(x);
{ tinh y }
If x= 0 then y:=0
else
If x> 0 then y:=Exp( 1/3*ln(x) )
else
y:= - Exp( 1/3*ln(-x) );
Writeln(' gia tri y= ' , y:8:4);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU91; tính tổng bình phương N số tự nhiên
Var
N, i : Integer;
S : LongInt;
Begin
Write('Nhap N : '); Readln(N);
S:=0;
For i:=1 to N do S:= S+i*i ;
Writeln('S= ', S);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU93;
{ Tính S=lũy thừa N của x }
Var
N, i : Byte ;
S, x : Real ;
Begin
Write('Nhap hai so x va N : ');
Readln( x, N);
S:=1;
For i:= 1 to N do S := S * x ;
Writeln('Luy thua= ', S : 6:2);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU94;
{ In bảng các chữ cái hoa và thường theo 2 cột }
Uses Crt;
Var
ch, ch1 : Char;
Dem: Integer;
Begin
CLRSCR;
Writeln('KY TU MA KY TU MA');
Dem:=0;
For ch:='a' to 'z' do
begin
ch1:=Upcase(ch);
Writeln( ch1:3 , Ord(ch1):6 , ch:6 , Ord(ch):6 );
Inc(Dem);
If Dem mod 15 = 0 then
begin
Write(' Enter de xem tiep ');
Readln;
end;
end;
Writeln('HET');
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU96;
{ In các chữ cái theo thứ tự đảo ngược từ z đến a}
Var
Ch: Char;
Begin
For ch:='Z' downto 'A' do write(ch:3 );
writeln;
For ch:='z' downto 'a' do write(ch :3 );
writeln;
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU99;
{ Tính tiền gửi ngân hàng sau N tháng}
Var
Tienvon, Laisuat, Sotien : Real;
N, i : Byte;
Begin
Write(' Nhap tien von, lai suat va so thang gui : ');
Readln(Tienvon, Laisuat, N);
For i:=1 to N do
begin
Sotien:= Tienvon + Tienvon*Laisuat;
Writeln('So tien sau ', i, ' thang =' , Sotien:8:2);
Tienvon:=Sotien;
end;
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU910;
{ Tính S=N! bằng lệnh WHILE..}
Var
N, i : Integer;
S : LongInt;
Begin
Write(' Nhap N > 0 : ' );
Readln(N);
S:=1;
i :=1;
While i<= N do
begin
S:=S*i;
i:=i+1;
end;
Writeln(' Giai thua = ', S);
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU913;
{ Tìm BSCNN của M và N }
Var
M, N, Max, BSCNN : Integer;
Begin
Repeat
Write(' Nhap M vao N duong :');
Readln(M, N);
Until (M>0) and (N>0);
If N>M then Max:=N else Max:=M;
BSCNN:=0;
Repeat
BSCNN:=BSCNN + Max;
Until (BSCNN mod N=0) and (BSCNN mod M=0) ;
Writeln(' Boi so chung nho nhat= ', BSCNN) ;
Readln;
End.
-------------------------------------------------------
PROGRAM VIDU914; { In tam giác }
Uses CRT;
Const
sao ='*';
Var
k, j, m: integer;
Traloi: Char;
Begin
REPEAT
Clrscr;
Repeat
Write(' Nhap m (0<20) : ');
Readln(m);
If (m <= 0) or ( m>=20) then write(#7);
Until (m>0) and ( m<20) ;
Writeln(sao :m);
For k:=1 to m-2 do
begin
Write(chr(32): m-k-1);
For j:=1 to 2*k+1 do Write(sao);
Writeln;
end;
For k:=1 to 2*m-1 do Write(sao);
Writeln;
Write(' Tiep tuc nua khong (Y/N) ?: ');
Readln( Traloi);
UNTIL (Traloi='N') or ( Traloi='n');

giai thừa)


Program giaithua;
Uses wincrt;
Var i,j,n: longint;
Begin
clrscr;
Writeln('Nhap so giai thua n= ');
Readln(n);
j:=1;
for i:=1 to n do j:=j*i;
writeln('n giai thua:',j);
readln;
end.

---------- Post added at 09:28 AM ---------- Previous post was at 09:27 AM ----------

số hoàn hảo nhỏ hơn n


Program So_hoan_hao_nho_honN;
uses wincrt ;
var N,i,s,K :longint;
Begin
clrscr ;
Write('moi nhap so N = ');
readln(N) ;
While K < N do
Begin
S:=0 ;
for i := 1 to K div 2 do
if k mod i = 0 then S:=S+i;
if S = k then write(k,' ') ;
k:=k+1;
end;
readln;
End.

---------- Post added at 09:29 AM ---------- Previous post was at 09:28 AM ----------

Tính tổng các chữ số trong N


Program Tinh_tong_cac_chu_so_trongN;
uses wincrt;
var N,S: integer;

Begin
write('Nhap n= ');
readln(n);
S:= 0;
while N <> 0 do
Begin
S:= S + N mod 10 ;
N:= N div 10;
End;

write('S= ',S);
readln
End.

---------- Post added at 09:36 AM ---------- Previous post was at 09:29 AM ----------

đây là cách tạo bảng cửu chương
Dùng mảng 2 chiều


Program bang_cuu_chuong;
Uses wincrt;
Var A: Array[1..10,2..9] of byte ;
i,j : byte ;
Begin
clrscr;
writeln('bang cuu chuong') ;
for i:= 1 to 10 do
for j:= 2 to 9 do
A[i,j] := i*j;
for i:= 1 to 10 do
for j := 2 to 9 do
write(j :4 ,'x', i:2,'=', A[i,j]:2);
readln;
end.

Đây là một số bài Pascal mẫu của vòng lặp không xác định While....do :

+ Viết chương trình tính phép chia chỉ bằng phép trừ :
Program Phep_chia;
Var
chia,bichia,luu,thuong,du:Integer;
Begin
Writeln('PHEP CHIA CHI LA PHEP TRU');
Writeln('-------------------------');
Write('-Nhap so bi chia: ');
Readln(bichia);
Write('-Nhap so chia: ');
Readln(chia);
luu:=bichia;
thuong:=0;
While bichia >=chia Do
Begin
bichia:=bichia-chia;
thuong:=thuong+1;
End;
du:=bichia;
Writeln;
Writeln('+Neu dem so ',luu,' chia cho so ',chia,' ket qua la: ');
Writeln(' *So thuong = ',thuong:6);
Writeln(' *So du = ',du:6);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Viết chương trình kiểm tra số vừa nhập vào có phải số nguyên tố hay không?
Program So_nguyen_to;
Var
n,i:Integer;
Begin
Writeln('SO VUA NHAP CO PHAI LA SO NGUYEN TO ?');
Writeln('-------------------------------------');
Write('-Nhap mot so : ');
Readln(n);
While n > 1 Do
Begin
i:=2;
While (n Mod i <> 0) Do
i:=i+1;
if i=n Then
Writeln('-So ',n,' la so nguyen to')
Else
Writeln('-So ',n,' khong phai la so nguyen to');
Write('-Nhap mot so (so 0 de ngung): ');
Readln(n);
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Viết chương trình nhập và xử lí điểm thi
Program Nhap_diem;
Const
Sentinel=-1;
Var
ten:String;
diem,cao,thap,dem:Integer;
Begin
Writeln('XU LY DIEM THI');
Writeln('--------------');
cao:=0;
thap:=10;
dem:=0;
Write('-Ho va ten sinh vien: ');
Readln(ten);
Write('-Nhap diem thi: ');
Readln(diem);
While diem <> Sentinel Do
Begin
If diem > cao Then
cao:=diem;
If diem < thap Then
thap:=diem;
dem:=dem+1;
Write('-Nhap diem thi: ');
Readln(diem)
End;
Writeln;
Writeln('+Sinh vien: ',ten);
Writeln('+Da co ',dem,' diem thi');
Writeln('+Diem cao nhat la: ',cao);
Writeln('+Diem thap nhat la: ',thap);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln;
End.

+ Viết chương trình in dãy số FIBONACI
Program Day_so_Fibonaci;
Var
n,j,pj,pj1,pj2:Integer;
Begin
Writeln('IN DAY SO FIBONACI');
Writeln('------------------');
Write('-Nhap so N= ');
Readln(n);
j:=2;
pj:=1;
pj1:=1;
While j <> n Do
Begin
pj2:=pj1;
pj1:=pj;
pj:=pj1+pj2;
j:=j+1;
End;
Writeln;
Writeln('+So hang thu ',n,' cua day Fibonaci = ',pj);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Viết chương trình tính trị của đa thức Pn
Program Da_thuc;
Var
n,i:Integer;
x,a,dathuc: Real;
Begin
Writeln('TINH TRI CUA DA THUC Pn');
Writeln('-----------------------');
Write('-Nhap so N= ');
Readln(n);
Write('-Nhap so X= ');
Readln(x);
i:=n;
Write('-Nhap tri so A',i,' =');
Readln(a);
dathuc:=a;
While i <> 0 Do
Begin
i:=i-1;
Write('-Nhap tri so A',i,' =');
Readln(a);
dathuc:=dathuc * x + a
End;
Writeln;
Writeln('+Tri cua da thuc = ',dathuc:12:10);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

• 5th class member

Tiếp một số bài đây :
+ Viết chương trình tính X lũy thừa N.
Program Luy_thua;
Var
x,n,tich,luythua:Integer;
Begin
Writeln('TINH TRI CUA X LUY THUA N');
Writeln('-------------------------');
Write('-Nhap vao so X= ');
Readln(x);
Write('-Nhap vao luy thua N= ');
Readln(n);
tich:=1;
luythua:=1;
While luythua <= n Do
Begin
tich:=tich * x;
luythua:=luythua + 1;
End;
Writeln;
Writeln(x,' luy thua ',n,' = ',tich);
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Cắt chuỗi nhập vào thành từng chữ
Program cat_chuoi;
Var
chuoi,tam:String;
Begin
Writeln('CAT CHUOI THANH TUNG TU');
Writeln('------------------------');
Write('-Nhap mot chuoi: ');
Readln(chuoi);
While chuoi <> '' Do
Begin
While chuoi[1] = #23 Do
chuoi:=copy(chuoi,2,255);
If pos(#32,chuoi) <> 0 Then
tam:=copy(chuoi,1,pos(#32,chuoi))
Else
tam:=chuoi;
Writeln(tam);
Delete(chuoi,1,length(tam));
End;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Phân tích Số nguyên N thành tích các thừa số nguyên tố
Program thuaso;
Var
n,i:Integer;
Begin
Writeln('PHAN TICH N THANH TICH CAC THUA SO NGUYEN TO');
Writeln('--------------------------------------------');
Write('-Nhap so N= ');
Readln(n);
Repeat
i:=2;
While (n Mod i <> 0) And (i < n ) Do
i:=i + 1;
Write(i:4);
n:=n Div i;
Until n=1;
Writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Viết chương trình tìm ước chung lớn nhât, Bội chung nhỏ nhất của 2 số nguyên
Program Uoc_so_Boi_so_chung;
Var
a,b:Word;
p:LongInt;
Begin
Writeln('UOC SO CHUNG LON NHAT, BOI SO CHUNG NHO NHAT');
Writeln('--------------------------------------------');
Write('-Nhap so thu nhat a= ');
Readln(a);
Write('-Nhap so thu hai b= ');
Readln(b);
p:=a * b;
Write('+Uoc so chung lon nhat cua ',a,' va ',b,' la: ');
While a <> b Do
Begin
If a > b Then
a:=a - b
Else
b:=b-a
End;
Writeln(a);
Writeln;
Writeln('+Boi so chung nho nhat cua chung la: ',p Div a);
writeln;
Writeln(' Bam phim <Enter> de ket thuc');
Readln
End.

+ Viết chương trình đoán số bạn đang nghĩ trong đầu (1<N<100).
Program Doan_so;
Var
tren,duoi,giua:Integer;
chon:Word;
Begin
tren:=100;
duoi:=1;