pascalcdsp

Bài 2: Nh?p n s? b?t kì t? bàn phím (không dùng m?ng) d?m các s? l?n hon 10 và nh? hon 20, tính t?ng c?a chúng. Ð?m các s? giá tr? b?ng 15. Ðua k?t qu? ra màn hình.  

program bai2; 

var n,i,dem1,dem2,tong,so:integer; 

write('nhap n: '); 

readln(n); 

tong:=0; dem1:=0; dem2:=0; 

for i:=1 to n do 

write('nhap so: '); 

readln(so); 

if (so>=10) and (so<=20) then 

tong:=tong+so; 

dem1:=dem1+1; 

end; 

if so=15 then dem2:=dem2+1; 

end; 

writeln('cac so lon hon 10 va nho hon 20 la: ',dem1); 

writeln('tong cua cac so >10 va <20 la: ',tong); 

writeln('cac so co gia tri = 15 la: ',dem2); 

readln; 

end.

Bài 3: Nh?p 4 s? a,b,c,d t? bàn phím. Hãy tìm giá tr? l?n nh?t và giá tr? nh? nh?t c?a s? dó.  

program bai3; 

var a,b,c,d,max,min:integer; 

write('nhap a: '); readln(a); 

write('nhap b: '); readln(b); 

write('nhap c: '); readln(c); 

write('nhap d: '); readln(d); 

max:=a; 

if b>max then max:=b; 

if c>max then max:=c; 

if d>max then max:=d; 

min:=a; 

if b<min then min:=b; 

if c<min then min:=c; 

if d<min then min:=d; 

writeln('gia tri lon nhat la: ',max); 

writeln('gia tri nho nhat la: ',min); 

readln; 

end.

Bài 5: Tìm các s? có 3 ch? s? abc sao cho t?ng các l?p phuong c?a các ch? s? b?ng chính s? dó. Abc=100a+10b+c=a3+b3+c3 

program bai5; 

var a,b,c:integer; 

for a:=1 to 9 do 

for b:=0 to 9 do 

for c:=0 to 9 do 

if (100*a+10*b+c = a*a*a+b*b*b+c*c*c) then 

writeln('tong cac lap phuong cua cac chu so bang chinh no la: ',a,b,c); 

readln; 

end.

Bài 4: Vi?t chuong trình nh?p m?t dãy s? nguyên t? bàn phím cho d?n khi g?p s? 0. Tính trung bình c?ng c?a dãy. Ð?m các s? duong c?a dãy và tính t?ng c?a chúng.  

program bai4; 

var so,i,dem,tong,tbc:integer; 

tong:=0; dem:=0; 

repeat 

write('nhap so: '); 

readln(so); 

if (so>0) then 

tong:=tong+so; 

dem:=dem+1; 

end; 

until so=0; 

if dem<>0 then 

writeln('tbc cua day la: ',tong/dem); 

writeln('cac so duong cua day la: ',dem); 

writeln('tong cua cac so duong la: ',tong); 

readln; 

end.

Bài 8: Vi?t chuong trình nh?p 2 s? a, b và m?t dãy s? nguyên t? bàn phím cho d?n khi g?p s? n?m ngoài kho?ng a, b cho tru?c. Tính t?ng các s? duong c?a dãy, d?m các s? âm và tính trung bình c?ng c?a dãy.  

program bai8; 

var a,b,n,so,tong1,dem1,tong2,dem2,tbc:integer; 

tong1:=0; dem1:=0;tong2:=0; dem2:=0; 

write('Nhap a: '); readln(a); 

write('Nhap b: '); readln(b); 

repeat 

write('Nhap so: '); readln(so); 

if (so>=0) then 

tong1:=tong1+so; 

dem1:=dem1+1; 

if (so<0) then 

dem2:=dem2+1; 

tong2:=tong2+so; 

until (so<a) or (so>b); 

writeln('Tong cac so duong cua day la: ',tong1); 

writeln('Cac so am cua day la: ',dem2); 

writeln('Tbc cua cac so nguyen duong la: ',tong1/dem1:4:2); 

readln; 

end.

Bài 10: Vi?t chuong trình nh?p m?t m?ng các s? nguyên, dua ra màn hình? Tính t?ng bình phuong các s? âm trong m?ng? Ð?m các s? duong và tính t?ng c?a chúng? Tìm ph?n t? có giá tr? nh? nh?t.  

program bai10; 

var a:array[1..10] of integer; 

n,i,tbp,tong,dem,min:integer; 

tong:=0; dem:=0; tbp:=0; 

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

for i:=1 to n do 

write('nhap a[',i,']: '); 

readln(a[i]); 

end; 

Writeln('Mang vua nhap la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{tinh tong binh phuong cac so am trong mang} 

for i:=1 to n do 

if a[i]<0 then 

tbp:=tbp+sqr(a[i]); 

writeln('Tong binh phuong cac so am la: ',tbp); 

{dem cac so duong va tinh tong} 

for i:=1 to n do 

if a[i]>0 then 

tong:=tong+a[i]; 

dem:=dem+1; 

end; 

writeln('So cac so duong la: ',dem); 

writeln('Tong cac so duong la: ',tong); 

{tim phan tu co gia tri nho nhat} 

min:=a[1]; 

for i:=2 to n do 

if min>a[i] then min:=a[i]; 

writeln('Gia tri nho nhat la: ',min); 

readln; 

end.

Bài 9: L?p trình các công vi?c sau 

- Nh?p t? bàn phím m?t dãy N s? nguyên vào m?t m?ng. Ðua m?ng dã cho ra màn hình 

- Chèn m?t ph?n t? vào m?ng t?i v? trí k, v?i k nh?p t? bàn phím. Ðua k?t qu? ra màn hình. 

- Xóa m?t ph?n t? kh?i v? trí k, k nh?p t? bàn phím. Ðua k?t qu? ra màn hình. 

- S?p x?p m?ng dã cho theo th? t? nào dó.Ðua k?t qu? ra màn hình.  

program bai11; 

var a:array[1..10] of integer; 

n,i,k,j,tg,x,so:integer; 

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

for i:=1 to n do 

write('nhap a[',i,']: '); 

readln(a[i]); 

end; 

Writeln('Mang vua nhap la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{chen 1 phan tu} 

write('Nhap so can chen: '); 

readln(so); 

write('Nhap vi tri can chen: '); 

readln(k); 

for i:=n downto k do 

a[i+1]:=a[i]; 

a[k]:=so; 

n:=n+1; 

end; 

for i:=1 to n do 

write(a[i]:4); writeln; 

{xoa 1 phan tu} 

write('Nhap vi tri can xoa: '); 

readln(x); 

for i:=x to n-1 do 

a[i]:=a[i+1]; 

n:=n-1; 

end; 

for i:=1 to n do 

write(a[i]:3); writeln; 

{sap xep mang} 

for i:=1 to n-1 do 

for j:=i+1 to n do 

if a[i]>a[j] then 

tg:=a[i]; 

a[i]:=a[j]; 

a[j]:=tg; 

end; 

writeln('Mang da sap xep la: '); 

for i:=1 to n do 

write(a[i]:4); writeln; 

readln; 

end.

Bài 12(k10): L?p trình các công vi?c sau: 

- Nh?p t? bàn phím m?t dãy N s? nguyên vào m?t m?ng. Ðua m?ng ra màn hình. 

- X?p các s? có giá tr? tuy?t d?i > 10 lên d?u dãy. Ðua k?t qu? ra màn hình. 

- Xóa các ph?n t? có giá tr? b?ng 5 trong dãy. Ðua k?t qu? ra màn hình  

program bai12; 

var a:array[1..10] of integer; 

n,i,k,j,tg,x,so:integer; 

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

for i:=1 to n do 

write('Nhap a[',i,']: '); 

readln(a[i]); 

end; 

Writeln('Mang vua nhap la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{sap xep mang} 

for i:=1 to n-1 do 

for j:=i+1 to n do 

if a[i]>a[j] then 

tg:=a[i]; 

a[i]:=a[j]; 

a[j]:=tg; 

end; 

write('Mang da sap xep la: '); 

for i:=1 to n do 

write(a[i]:4); writeln; 

{xoa 1 phan tu} 

for i:=n downto 1 do 

if a[i]=5 then 

for j:=1 to n-1 do 

a[i]:=a[i+1]; 

n:=n-1; 

end; 

writeln('Mang da xoa cac gia tri = 5 la: '); 

for i:=1 to n do 

write(a[i]:3); writeln;

readln; 

end.

bài 13: L?p trình các công vi?c sau: 

- Nh?p t? bàn phím m?t dãy N s? nguyên vào m?t m?ng. Ðua m?ng ra màn hình. 

- S?p x?p m?ng dã cho theo th? t? nào dó. Ðua k?t qu? ra màn hình. 

- Chèn m?t ph?n t? vào m?ng mà v?n d?m b?o tính s?p x?p c?a nó. Ðua k?t qu? ra màn hìnhs  

program bai13; 

var a:array[1..10] of integer; 

n,i,k,j,tg,x,so:integer; 

write('So phan tu cua mang la: '); readln(n); 

for i:=1 to n do 

write('Nhap a[',i,']: '); 

read(a[i]); 

end; 

Write('Mang vua nhap la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{sap xep mang} 

for i:=1 to n-1 do 

for j:=i+1 to n do 

if a[i]>a[j] then 

tg:=a[i]; 

a[i]:=a[j]; 

a[j]:=tg; 

end; 

write('Mang da sap xep la: '); 

for i:=1 to n do 

write(a[i]:4); writeln; 

{chen 1 phan tu} 

write('Nhap so can chen: '); 

readln(so); 

write('Nhap vi tri can chen: '); 

readln(k); 

for i:=n downto k do 

a[i+1]:=a[i]; 

a[k]:=so; 

n:=n+1; 

end; 

writeln('Mang da chen la: '); 

for i:=1 to n do 

write(a[i]:4); writeln; 

Writeln('Het'); 

readln; 

end.

Bài 14(k10): L?p trình các công vi?c sau: 

- Nh?p t? bàn phím m?t dãy N s? nguyên vào m?t m?ng. Ðua m?ng ra màn hình. 

- xóa các ph?n t? thu?c do?n [10,100]. Ðua k?t qu? ra màn hình 

- xóa các ph?n t? có giá tr? <5 trong dãy. Ðua k?t qu? ra màn hình  

program bai14; 

var a:array[1..10] of integer; 

n,i,j,x:integer; 

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

for i:=1 to n do 

write('Nhap a[',i,']: '); 

readln(a[i]); 

end; 

Writeln('Mang vua nhap ah: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{xoa cac so >10 va <100} 

for i:=n downto 1 do 

if (a[i]>=10) and (a[i]<=100) then 

for j:=i to n-1 do 

a[j]:=a[j+1]; 

n:=n-1; 

end; 

writeln('Mang da xoa cac phan tu >10 va <100 la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

{xoa phan tu <5 trong day} 

for i:=n downto 1 do 

if a[i]<5 then 

for j:=i to n-1 do 

a[j]:=a[j+1]; 

n:=n-1; 

end; 

writeln('Mang da xoa cac phan tu <5 la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

readln; 

end.

Bài 17: Vi?t chuong trình nh?p 1 xâu kí t? t? bán phím, dua xâu dã nh?p ra màn hình. Nh?p 1 kí t? t? bàn phím d?m xem trong xâu dã cho có bao nhiêu kí t? trùng v?i kí t? nh?p t? bàn phím

Program bai17; 

Var 

st:String[80]; 

i,dem:byte; 

ch:char; 

Begin 

Write('Nhap xau: '); Readln(st); 

Writeln('Xau vua nhap la: ',st); 

Dem := 0; 

Write (' nhap ki tu:'); 

Readln(ch); 

For I := 1 to length(st) do 

If st[i] = ch then dem:= dem+1; 

If dem <> 0 then 

Writeln ('ki tu',ch,'xuat hien',dem,'lan'); 

Readln; 

End.

Bài 15: Nh?p vào N s? nguyên t? bàn phím: 

- d?m các sô chia h?t cho 3 

- d?m các s? n?m trong do?n [10,200]. Tính t?ng và trung bình c?ng c?a chúng 

- ki?m tra dãy dã cho có t?o thành 1 c?p s? c?ng không 

- x?p các s? chia h?t cho 3 lên d?u dãy  

program bai15; 

var a:array[1..10] of integer; 

N,i,j,tg,tong,dem1,dem2,tbc:integer; 

Begin 

tong:=0;dem1:=0;dem2:=0;tbc:=0; 

write('Nhap N: '); readln(N); 

for i:=1 to N do 

write('Nhap a[',i,']: '); 

readln(a[i]); 

end; 

Writeln('Mang vua nhap la: '); 

for i:=1 to n do 

write(a[i]:3); writeln; 

Begin 

for i:=1 to N do 

if a[i] mod 3=0 then 

dem1:=dem1+1; 

writeln('Cac so chia het cho 3 la: ',dem1); 

End; 

Begin 

for i:=1 to n do 

if (a[i]>10) and (a[i]<200) then 

tong:=tong+a[i]; 

dem2:=dem2+1; 

end; 

writeln('Cac so nam trong doan [10,200] la: ',dem2:4); 

writeln('Tong cac so nam trong doan[10,200] la: ',tong:4); 

writeln('Trung binh cong la: ',tong/dem2:4:2); 

End; 

{xep cac so chia het cho 3 len dau day} 

for i:= 1 to n-1 do 

for j:=i+1 to n do 

if (a[j] mod 3=0) then 

tg:=a[i]; 

a[i]:=a[j]; 

a[j]:=tg; 

end; 

writeln('Mang da sap xep la: '); 

for i:=1 to n do 

write(a[i]:4); 

readln; 

end.

BAI 10 k1110,Vi?t chuong trình th?c hi?n các vi?c sau: 

1.Nh?p t? bàn phím 1 dãy N s? nguyên vào m?ng 1 chi?u,in m?ng ra màn hình? 

2.X?p các s? có giá tr? b?ng 5 lên d?u dãy.In k?t qu? ra màn hình? 

3.Xóa các s? có giá tr? b?ng 10 trong m?ng.In k?t qu? ra màn hình? 

4.Xóa các s? có giá tr? trong do?n [-10,10].In k?t qu? ra màn hình?

uses crt; 

var c,n,m,k,i,j,s,dem,le,max,min:integer; 

a,b:array[1..10000] of integer;

clrscr; 

write('Nhap so nguyen N: ');readln(n); 

repeat 

inc(i); 

write('Nhap a[',i,']: ');readln(a[i]); 

until i=n; 

write('Mang vua nhap: ');writeln; 

for i:=1 to n do write(a[i]:4);writeln; 

writeln('Mang xep so 5 len dau:'); 

for i:=1 to n do 

if a[i]=5 then begin inc(dem); for j:=i to n do a[j]:=a[j+1] end; 

for j:=1 to dem do b[j]:=5; 

for i:=1 to n do begin inc(s); 

if a[i]<>5 then b[dem+s]:=a[i] end; 

for i:=1 to n do write(b[i]:4);writeln; 

writeln('Mang xoa phan tu co gia tri 10 la:'); 

for i:=1 to n do 

if b[i]=10 then begin inc(le); for j:=i to n do b[j]:=b[j+1] end; 

for i:=1 to n-le do write(b[i]:4);writeln; 

writeln('Mang xoa phan tu co gia tri thuoc [-10,10] la:'); 

j:=0; 

for i:=1 to n do 

if (a[i]<=-10)or(a[i]>=10) then begin inc(j); 

b[j]:=a[i] end; 

for i:=1 to j do write(b[i]:4);

readln 

end.

11,Vi?t chuong trình th?c hi?n các vi?c sau: 

1.Nh?p t? bàn phím 1 dãy N s? nguyên vào m?ng 1 chi?u,in m?ng ra màn hình? 

2.S?p x?p m?ng theo th? t? tang.In m?ng ra màn hình? 

3.Chén 1 ph?n t? vào m?ng mà v?n d?m b?o tính s?p x?p c?a nó.In m?ng ra màn hình?

uses crt; 

var c,n,m,k,i,j,s,dem,le,max,min:integer; 

a,b:array[1..10000] of integer;

clrscr; 

write('Nhap so nguyen N: ');readln(n); 

repeat 

inc(i); 

write('Nhap a[',i,']: ');readln(a[i]); 

until i=n; 

write('Mang sap xem tang: ');writeln; 

for i:=1 to n do write(a[i]:4);writeln; 

for i:=1 to n-1 do 

for j:=i+1 to n do 

if a[j]<a[i] then begin 

s:=a[i]; 

a[i]:=a[j]; 

a[j]:=s 

end; 

write('Mang duoc sap xep tang la: ');writeln; 

for i:=1 to n do write(a[i]:4);writeln; 

write('Nhap phan tu bo sung: ');readln(k); 

a[n+1]:=k; 

for i:=1 to n do 

for j:=i+1 to n+1 do 

if a[j]<a[i] then begin 

s:=a[i]; 

a[i]:=a[j]; 

a[j]:=s 

end; 

write('Mang sau khi chen phan tu ',k,' : ');writeln; 

for i:=1 to n+1 do write(a[i]:4);writeln; 

readln 

end.

bai12,Vi?t chuong trình th?c hi?n các vi?c sau: 

1.Nh?p t? bàn phím 1 dãy N s? nguyên vào m?ng 1 chi?u,in m?ng ra màn hình? 

2.Tính trung bình c?ng c?a các s? l? và chia h?t cho 3.In k?t qu? ra màn hình? 

3.Ki?m tra xem dãy s? dã cho có t?o thành c?p s? c?ng không?In k?t qu? ra màn hình? 

4.X?p s? ch?n lên d?u dãy.In k?t qu? ra màn hình?

uses crt; 

var c,n,m,k,i,j,s,dem,le,max,min,u:integer; 

t:boolean; 

a,b:array[1..10000] of integer;

clrscr; 

write('Nhap so nguyen N: ');readln(n); 

repeat 

inc(i); 

write('Nhap a[',i,']: ');readln(a[i]); 

if (a[i] mod 2 <>0) and (a[i] mod 3 =0) then begin 

inc(dem); 

inc(s,a[i]) 

end; 

until i=n; 

write('Mang vua nhap la: ');writeln; 

for i:=1 to n do write(a[i]:4);writeln; 

if dem<>0 then write('Trung binh cong cac so le va chia het cho 3 la: ',s/dem) 

else write('Day khong co so le va chia het cho 3');writeln; 

for i:=1 to n-1 do 

for j:=i+1 to n do 

if a[j]<a[i] then begin 

m:=a[i]; 

a[i]:=a[j]; 

a[j]:=m 

end; 

k:=a[2]-a[1]; 

t:=true; 

for i:=1 to n-1 do 

if a[i+1]-a[i]=k then t:=true 

else t:=false; 

if t=true then writeln('Day so la cap so cong') 

else writeln('Day khong la cap so cong'); 

writeln('Day da xep cac so chan len dau la:'); 

for i:=1 to n-1 do 

for j:=i to n do 

if a[i] mod 2<>0 then begin 

u:=a[i]; 

a[i]:=a[j]; 

a[j]:=u end; 

for i:=1 to n do write(a[i]:4);

readln 

end.

bai14,Nh?p ma tr?n vuông A[N,N]. 

1.Ð?m các ph?n t? l?n hon 0 

2.Ð?m các ph?n t? nh? hon 0 

3.Ð?m các ph?n t? =0. 

4.TÍnh t?ng các ph?n t? >0 trên các hàng ch?n.In k?t qu? ra màn hình?

uses crt; 

var n,m,k,i,j,s,dem,le,max,min:integer; 

b,c:array[1..10000] of integer; 

a:array[1..100,1..100] of integer;

clrscr; 

write('Nhap N: ');readln(n);s:=0; 

for i:=1 to n do 

for j:=1 to n do begin 

write('a[',i,',',j,']: ');readln(a[i,j]); 

if a[i,j]>0 then begin 

inc(dem); 

if i mod 2=0 then inc(s,a[i,j]) end; 

if a[i,j]<0 then inc(le); 

if a[i,j]=0 then inc(min) 

end; 

writeln(dem:3,le:3,min:3); 

write('Tong cac phan tu >0 tren hang chan la: ',s);

readln

bai27,Vi?t chuong trình hu?ng d?n ngu?i s? d?ng ch?n công vi?c trong 1 menu TEXT g?m các l?a ch?n sau : 

1.TÍnh t?ng di?n tích 2 hình vuông? 

2.Nh?p và d?m s? t? c?a 1 xâu ký t?? 

3.Tính UCLN c?a 2 s? nguyên nh?p tùa bàn phím? 

4.K?t thúc chuong trình? 

Ngu?i s? d?ng gõ 1 phím s? trên bàn phím d? l?a ch?n công vi?c trong menu 

end.

uses crt; 

var n,m,k,h,i,j,dem,le,max,min:integer; 

chon,c:char; 

clrscr; 

writeln('Danh sach: '); 

writeln(' 1.Tinh tong dien tich 2 hinh vuong?'); 

writeln(' 2.Nhap va dem so tu cua 1 xau ky tu?'); 

writeln(' 3.Tinh UCLN cua 2 so nguyen nhap tu ban phim?'); 

writeln(' 4.Ket thuc chuong trinh?'); 

writeln; 

repeat 

write('An phim 1 -> 4 de chon muc tuong ung: ');readln(chon); 

until (chon='1')or(chon='2')or(chon='3')or(chon='4'); 

if chon='1' then begin clrscr; 

write('Tinh tong dien tich 2 hinh vuong?') end; 

if chon='2' then begin clrscr; 

write('Nhap va dem so tu cua 1 xau ky tu?') end; 

if chon='3' then begin clrscr; 

write('Tinh UCLN cua 2 so nguyen nhap tu ban phim?') end; 

if chon='4' then write('An phim Enter de thoat chuong trinh'); 

readln 

end.

bai28,Vi?t chuong trình có s? d?ng các chuong trình con sau: 

1.Nh?p m?ng 1 chi?u t? bàn phím? 

2.In m?ng dã cho ra màn hình? 

3.Nh?p m?ng 2 chi?u t? bàn phím? 

4.In m?ng 2 chi?u ra màn hình? 

5.Nhân 2 ma tr?n?

uses crt; 

var n,m,k,h,i,j,x,y,q,p,l:integer; 

a:array[1..1000] of integer; 

b,c,d:array[1..100,1..100] of integer; 

procedure input; 

writeln('Nhap 0 de ket thuc nhap lieu'); 

write('Nhap so nguyen N: ');readln(n); 

for i:=1 to n do begin 

write('Nhap a[',i,']: ');readln(a[i]) 

end; 

end; 

procedure output; 

for i:=1 to n do write(a[i]:4);writeln; 

end; 

procedure input1; 

writeln('Nhap mang 2 chieu: '); 

write('Nhap so nguyen M: ');readln(m); 

for h:=1 to m do 

for k:=1 to m do begin 

write('Nhap b[',h,',',k,']: ');readln(b[h,k]); 

end; 

end; 

procedure output2; 

for i:=1 to m do begin 

for j:=1 to m do write(b[i,j]:4);writeln 

end; 

end; 

procedure matran; 

clrscr; 

write('Nhap so dong ma tran A: ');readln(m); 

write('Nhap so cot ma tra A: ');readln(n); 

for i:=1 to m do 

for j:=1 to n do begin 

write('b[',i,',',j,']: ');readln(b[i,j]); 

end; 

write('Nhap so dong ma tran B: ');readln(x); 

write('Nhap so cot ma tra B: ');readln(y); 

for i:=1 to x do 

for j:=1 to y do begin 

write('c[',i,',',j,']: ');readln(c[i,j]); 

end;

if n=x then begin 

for i:=1 to n do 

for j:=1 to y do 

for l:=1 to n do d[i,j]:=d[i,j]+(b[i,l]*c[l,j]);

writeln('Ma tran tich la:'); 

for i:=1 to n do begin 

for j:=1 to y do write(d[i,j]:4);writeln end;end

else write('Sai dieu kien'); 

readln 

end; 

clrscr; 

input;output; 

input1;output2;matran; 

readln 

end.

BAI25 TINH N! VA TONG 1!+..+M!

PROGRAM BAI25;

USES CRT;

VAR I,N,S,P: LONGINT;

BEGIN

CLRSCR;

        WRITELN('NHAP N = '); READLN(N);

        S:=1; P:=0;

        FOR I := 1 TO N DO

        BEGIN

                 S:= S*I;

                 P:= P+S;

        END;

        WRITELN('GIAI THUA = ',S);

        WRITELN('TONG GIAI THUA = ',P);

        READLN;

end.

BAI 26 TIM UCLN

Program CT_TIM_USCLN_CUA_2_SO;

Uses CRT;

VAR A,B : Longint;

FUNCTION UCLN(x,y:Longint):Longint;

Begin

While (x>0) And (y>0) do

If x>y Then x:=x-y

Else y:=y-x;

UCLN:=x+y;

End;

BEGIN

Write('Nhap 2 so a,b '); Readln(a,b);

Writeln('Uoc chung lon nhat la ', UCLN(a,b));

Readln;

END.

Ba?n co´ thê? viê´t FUNCTION UCLN nhu sau:

FUNCTION UCLN(x,y:Longint):Longint;

Var r:Longint;

Begin

While y>0 do

Begin

r:= x mod y;

x:=y;

y:=r;

End;

UCLN:=x;

End;

readln

end.

bai31

uses crt;

type sv=record

              ht:string[30];

              ns:integer;

              tb:byte;

              end;

var a,b:sv;

    i,j,m,n,k,h,x,y:integer;

    s:string;t:boolean;

    ds:array [1..100] of sv;

     clrscr;

     t:=true;

     write('Nhap so sinh vien: ');readln(n);

     for i:=1 to n do with ds[i] do

           write('',i,': ');write('Ho ten: ');readln(ht);

           write('Nam sinh: ');readln(ns);

           write('Diem trung binh: ');readln(tb);

     end;

     clrscr;

     writeln('Danh sach sinh vien:');

     for i:=1 to n do with ds[i] do begin

        write('',i,'.');writeln(ht,ns:6,tb:4) end;

     write('Nhap vi tri sinh vien ban muon sua thong tin: ');readln(k);

     for i:=k to k do with ds[i] do

           write('',i,': ');write('Ho ten: ');readln(ht);

           write('Nam sinh: ');readln(ns);

           write('Diem trung binh: ');readln(tb);

     end;

     clrscr;

     writeln('Danh sach sinh vien:');

     for i:=1 to n do with ds[i] do begin

        write('',i,'.');writeln(ht,ns:6,tb:4) end;

        writeln('Danh sach sinh vien diem tb 5 tro len:');

     i:=0;

     while i<>n do with ds[i] do begin inc(i);

           if tb>=5 then begin

                         for j:=1 to n-1 do

                             for h:=j to n do

                                 if ds[h].tb>ds[j].tb then begin x:=ds[j].tb;

                                                    ds[j].tb:=ds[h].tb;

                                                    ds[h].tb:=x end;

                         write('',i,'.');writeln(ht,ns:6,tb:4) end

                    else begin

                         writeln('Danh sach sv thi lai la :');

                         for

                         end;

                         end;

     readln

end.

bai32

uses crt;

type sv=record

              ten:string[30];

              sl:integer;

              gia:integer;

              hh:integer;

              tien:integer

              end;

var a,b:sv;

    i,j,m,n,k,h,x,y,dem:integer;

    c:char;

    s:string;t:boolean;

    ds:array [1..100] of sv;

     clrscr;

     t:=true;i:=0;

     while t do with ds[i] do

     begin inc(i);

           write('',i,': ');write('Ten thuoc: ');readln(ten);

           if ten='*' then break;

           write('So luong: ');readln(sl);

           write('Don gia: ');readln(gia);

           write('Nam het ham: ');readln(hh);

           write('Thanh tien: ');readln(tien);

     end;

     clrscr;

     writeln('Nhap nam kiem tra: ');readln(n);

     writeln('Danh sach thuoc da het han:');

     while j<>i-1 do with ds[j] do

     begin inc(j);

           if hh<n then begin

              write('',j,'.');writeln(ten,hh:6); end;end;

     writeln('Danh sach thuoc:');

     while j<>i-1 do with ds[j] do

     begin inc(j);

           if hh<n then begin inc(dem);

              for x:=i downto j do ds[x]:=ds[x-1] end; end;j:=0;

     while j<>i-dem-1 do with ds[j] do

     begin inc(j);

     write('',j,':');writeln(ten,hh:6) end;

     readln

end.

bai30

uses crt;

type sv=record

              ht:string[30];

              ns:integer;

              que:string[20];

              gt:byte;

              end;

var a,b:sv;

    i,j,m,n:integer;

    s:string;t:boolean;

    ds:array [1..100] of sv;

     clrscr;

     t:=true;

     write('Nhap so sinh vien: ');readln(n);

     writeln('Quy uoc: Nam la 1 ,Nu la 0');

     for i:=1 to n do with ds[i] do

           write('',i,': ');write('Ho ten: ');readln(ht);

           write('Nam sinh: ');readln(ns);

           write('Que: ');readln(que);

           write('Gioi tinh: ');readln(gt);

     end;

     clrscr;

     writeln('Danh sach sinh vien:');

     for i:=1 to n do with ds[i] do begin

        write('',i,'.');writeln(ht,ns:6,que:20,gt:6) end;

     i:=0;writeln('Danh sach sinh vien nam que Hai Phong la:');

     while i<>n do with ds[i] do begin inc(i);

           if (que='hai phong') and (gt=1) then

                  write('',i,'.');writeln(ht,ns:6,que:20,gt:6) end;end;

     j:=0; writeln('Danh sach sinh vien nu sinh sau nam 1990:');

     while j<>n do with ds[j] do begin inc(j);

           if (ns>1990) and (gt=0) then

                  write('',j,'.');writeln(ht,ns:6,que:20,gt:6) end;end;

     readln

end.

bai40

 unit toan;

interface

uses crt;

function ht(a,b,c:integer):integer;

function tron(n:integer):real;

function FIBONACI(n:integer):integer;

function UCLN(a,b:integer):integer;

function NTO(n:integer):boolean;

implementation

function ht(a,b,c:integer):integer;

      ht:=((a+b)*c) div 2;

end;

function tron(n:integer):real;

var x:real;

     x:=sqr(n)*(3.14);

     tron:=x;

end;

function FIBONACI(n:integer):integer;

     if n<3 then FIBONACI:=1

            else FIBONACI:=FIBONACI(n-1)+FIBONACI(n-2);

end;

function UCLN(a,b:integer):integer;

     while a*b<>0 do

           if a>b then a:=a mod b

                  else b:=b mod a;

     UCLN:=a+b;

end;

function NTO(n:integer):boolean;

var t:boolean;

    i,j:integer;

     t:=true;

     while (i<=trunc(sqrt(n))) and t do

         if n div i<>0 then t:=true

                       else t:=false;

     nto:=t

end;

end.

Bạn đang đọc truyện trên: AzTruyen.Top