Diễn đàn tin học Văn Lang - Vạn Ninh
Chào mừng bạn đến với Diễn đàn Tin học Văn Lang - Vạn Ninh của chúng tôi !
Hãy đăng nhập hoặc đăng kí tài khoản để trải nghiệm nhiều điều thú vị tại đây !
Thân ái !

Diễn đàn tin học Văn Lang - Vạn Ninh

Nơi trao đổi thông tin, tăng cường hợp tác, giải đáp những vướng mắc khi học lập trình Pascal
 
Trang ChínhCalendarTrợ giúpTìm kiếmThành viênNhómĐăng kýĐăng Nhập

Share | 
 

 đề thử 2009

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giảThông điệp
pqtoan



Posts : 72
Danh tiếng : 3
Join date : 10/11/2014

Bài gửiTiêu đề: đề thử 2009    12/10/2016, 11:00

Bai 1:
uses crt;
const so=['1'..'9'];
var a:string;
   i,tong,n,dem,code:integer;
begin
clrscr;
repeat
writeln('Nhap chuoi co it nhat 1 so nguyen duong:');readln(a);
dem:=0;
for i:=1 to length(a) do if a[i] in so then dem:=dem+1;
if dem=0 then writeln('Nhap thieu');
until dem>=1;
writeln('Chuoi do la:',a);
tong:=0;
for i:=1 to length(a) do if a[i] in so then
begin
    val(a[i],n,code);
    tong:=tong+n;
end;
writeln('Tong cac so trong chuoi la:',tong);
readln;
end.
Về Đầu Trang Go down
Xem lý lịch thành viên
pqtoan



Posts : 72
Danh tiếng : 3
Join date : 10/11/2014

Bài gửiTiêu đề: Re: đề thử 2009    12/10/2016, 11:02

Bai 2:
uses crt;
var a1,b1,a2,b2,n,i:integer;
{-}
function ngay(thang,n:integer):integer;
begin
if n mod 4=0 then
case thang of
1,3,5,7,8,10,12:ngay:=31;
4,6,9,11:ngay:=30;
2:ngay:=29;
end
else
case thang of
1,3,5,7,8,10,12:ngay:=31;
4,6,9,11:ngay:=30;
2:ngay:=28;
end;
end;
procedure nhap(var a,b:integer);
begin
repeat
write('Nhap ngay:');readln(a);
write('Nhap thang:');readln(b);
if (b<=0) or (b>12) or (a<=0) or (a>ngay(b,n)) then writeln('Nhap Sai');
until (b>0) and (b<=12) and (a>0) and (a<=ngay(b,n));
end;
function w(var a1,b1,a2,b2,n:integer):integer;
var tong,i:integer;
begin
tong:=0;
if b1=b2 then
begin
if a1>a2 then tong:=a1-a2+1
else tong:=a2-a1+1;
end;
if b1<b2 then
begin
for i:=b1+1 to b2-1 do tong:=tong+ngay(i,n);
tong:=tong+(ngay(b1,n)-a1)+a2;
end;
if b1>b2 then
begin
for i:=b2+1 to b1-1 do tong:=tong+ngay(i,n);
tong:=tong+(ngay(b2,n)-a2)+a1;
end;
w:=tong;
end;
{-}
begin
clrscr;
write('Nhap nam:');readln(n);
writeln('~~~~~MOC 1~~~~~');
nhap(a1,b1);
writeln('~~~~~MOC 2~~~~~');
nhap(a2,b2);
writeln('Ngay ',a1,'/',b1,' va ngay ',a2,'/',b2,' cach nhau ',w(a1,b1,a2,b2,n),' ngay');
readln;
end.
Về Đầu Trang Go down
Xem lý lịch thành viên
pqtoan



Posts : 72
Danh tiếng : 3
Join date : 10/11/2014

Bài gửiTiêu đề: Re: đề thử 2009    12/10/2016, 11:03

Bai 3:
uses crt;
var a,uoc:array[1..100] of integer;
n,i,j:integer;
{-}
procedure dc(var a,b:integer);
var i:integer;
begin
i:=a;a:=b;b:=i;
end;
{-}
begin
clrscr;
write('Nhap phan tu day:');readln(n);
for i:=1 to n do
begin
write('a[',i,']:');readln(a[i]);
end;
for i:=1 to n do uoc[i]:=0;
for i:=1 to n do
for j:=1 to a[i] do if a[i] mod j=0 then uoc[i]:=uoc[i]+1;
for i:=1 to n-1 do for j:=i+1 to n do if uoc[i]>uoc[j] then
begin
dc(uoc[i],uoc[j]);dc(a[i],a[j]);
end;
write('Day sau sap xep la:');
for i:=1 to n do write(a[i]:5);writeln;
readln;
end.
Về Đầu Trang Go down
Xem lý lịch thành viên
Sponsored content




Bài gửiTiêu đề: Re: đề thử 2009    

Về Đầu Trang Go down
 
đề thử 2009
Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang
 Similar topics
-
» Beneath the Glory (nhạc phim Hoa Mộc Lan 2009)
» Những đoạn văn chết cười trong kỳ thi Tốt nghiệp THPT 2009
» Hướng dẫn đan khăn
» Hỏi về mẫu đan áo M007
» Đan đan móc móc Hè 2009

Permissions in this forum:Bạn không có quyền trả lời bài viết
Diễn đàn tin học Văn Lang - Vạn Ninh :: Bài tập :: Bài tập cơ bản-
Chuyển đến