program kalendar;
uses crt,dos;
type date=record
den, mesic, rok, dvt: integer;
end;
var cas_h,cas_m,cas_v,cas_vv:word;
datum_r,datum_m,datum_d,datum_dt:word;
chci,dnes:date;
klavesa:char;
p:integer;
{**********************************************************************}
function prestupny(rok:integer):boolean;
begin
if (rok/4) = round(rok/4) then prestupny:=true else prestupny:=false;
if (rok/100) = round(rok/100) then prestupny:=false;
if (rok/400) = round(rok/400) then prestupny:=true;
end;
procedure datum(d_r,d_m,d_d,d_dt:integer);
begin
case d_dt of
0:write('nedele');
1:write('pondeli');
2:write('utery');
3:write('streda');
4:write('ctvrtek');
5:write('patek');
6:write('sobota');
end;
Writeln(' ',d_d,'. ',d_m,'. ',d_r,' ');
if prestupny(d_r)=true then writeln('je prestupny rok');
end;
procedure cas(c_h,c_m,c_v,c_vv:integer);
begin
Writeln('Cas: ',c_h,':',c_m);
end;
procedure kolik(chci_rok,chci_den,chci_dvt,rok,mesic,den,dvt:integer);
var p,q,a:date;
pocet,pocet2:word;
begin
pocet:=0;
a.den:=den;
a.mesic:=mesic;
a.dvt:=dvt;
a.rok:=rok;
p.dvt:=dvt-1;
{**************************************************************}
if chci_rok>rok then begin
for p.rok:=rok to chci_rok do begin
{ writeln('ROK ',p.rok);}
for p.mesic:=mesic to 12 do begin
{ writeln(p.mesic,':-)');}
case p.mesic of
1: q.den:=31; 2: begin q.den:=28; if prestupny(p.rok) then q.den:=29; end;
3: q.den:=31; 4: q.den:=30; 5: q.den:=31; 6: q.den:=30;
7: q.den:=31; 8: q.den:=31; 9: q.den:=30; 10:q.den:=31;
11:q.den:=30; 12:q.den:=31;
end;
for p.den:=den to q.den do begin
p.dvt:=p.dvt+1; if p.dvt=7 then p.dvt:=0;
if (chci_den=p.den) and (p.dvt=chci_dvt) then pocet:=pocet+1;
{ write(p.den,'_',p.dvt,' * ');}
end;
den:=1;
{ writeln;}
end;
mesic:=1;
{ writeln('Rok ',p.rok);
writeln('Pocet dnu v tydnu (',chci_dvt,') a dnu (',chci_den,') je: ',pocet);}
{ readln;}
pocet2:=pocet;
pocet:=0;
{ writeln;}
end;
end;
{**************************************************************}
q.den:=den;
p.dvt:=p.dvt+2;
if chci_rok=rok then begin
{ writeln('ROK ',rok);}
for p.mesic:=mesic downto 1 do begin
{ writeln(p.mesic,':-)');}
for p.den:=q.den downto 1 do begin
p.dvt:=p.dvt-1; if p.dvt=-1 then p.dvt:=6;
{ write(p.den,'_',p.dvt,' * ');}
end;
case p.mesic of
1: q.den:=31;
2: begin q.den:=28; if prestupny(rok) then q.den:=29; end;
3: q.den:=31;
4: q.den:=30;
5: q.den:=31;
6: q.den:=30;
7: q.den:=31;
8: q.den:=31;
9: q.den:=30;
10:q.den:=31;
11:q.den:=30;
12:q.den:=31;
end;
{ writeln;}
end;
pocet:=0;
{*****}
{ writeln('ROK ',rok);}
for p.mesic:=1 to 12 do begin
{ writeln(p.mesic,':-)');}
case p.mesic of
1: q.den:=31;
2: begin q.den:=28; if prestupny(rok) then q.den:=29; end;
3: q.den:=31;
4: q.den:=30;
5: q.den:=31;
6: q.den:=30;
7: q.den:=31;
8: q.den:=31;
9: q.den:=30;
10:q.den:=31;
11:q.den:=30;
12:q.den:=31;
end;
for p.den:=1 to q.den do begin
if (chci_den=p.den) and (p.dvt=chci_dvt) then pocet:=pocet+1;
{ write(p.den,'_',p.dvt,' * ');}
p.dvt:=p.dvt+1; if p.dvt=7 then p.dvt:=0;
end;
end;
p.rok:=rok;
pocet2:=pocet;
pocet:=0;
end;
{**************************************************************}
if chci_rok<rok then begin
for p.rok:=rok downto chci_rok do begin
{ writeln('ROK ',p.rok);}
for p.mesic:=mesic downto 1 do begin
{ writeln(p.mesic,':-)');}
for p.den:=q.den downto 1 do begin
p.dvt:=p.dvt-1; if p.dvt=-1 then p.dvt:=6;
if (chci_den=p.den) and (p.dvt=chci_dvt) then pocet:=pocet+1;
{ write(p.den,'_',p.dvt,' * ');}
end;
case p.mesic of
1: q.den:=31;
2: begin q.den:=28; if prestupny(p.rok) then q.den:=29; end;
3: q.den:=31;
4: q.den:=30;
5: q.den:=31;
6: q.den:=30;
7: q.den:=31;
8: q.den:=31;
9: q.den:=30;
10:q.den:=31;
11:q.den:=30;
12:q.den:=31;
end;
{ writeln;}
end;
{ writeln('Rok ',p.rok);
writeln('Pocet dnu v tydnu (',chci_dvt,') a dnu (',chci_den,') je: ',pocet);}
{ readln;}
pocet2:=pocet;
pocet:=0;
end;
end;
{**************************************************************}
write('Pocet ');
case chci_dvt of
0: write('nedeli');
1: write('pondelku');
2: write('uterku');
3: write('stred');
4: write('ctvrtku');
5: write('patku');
6: write('sobot');
end;
writeln(' ',chci_den,'. v roce ',chci_rok,' je: ',pocet2);
end; {kolik}
label aa;
{-------------------------------------------------------------------}
begin
repeat
clrscr;
textcolor(14);
writeln;
gettime(cas_h,cas_m,cas_v,cas_vv);
getdate(datum_r,datum_m,datum_d,datum_dt);
{ datum(datum_r,datum_m,datum_d,datum_dt);
cas(cas_h,cas_m,cas_v,cas_vv);}
writeln;writeln;writeln;
textcolor(15);
dnes.den:=datum_d; dnes.mesic:=datum_m; dnes.rok:=datum_r; dnes.dvt:=datum_dt;
Write('Zadejte, jaky chcete rok: ');
repeat
gotoxy(27,5);for p:=1 to 40 do write(' ');
gotoxy(27,5);
readln(chci.rok);
until chci.rok<32000;
write('Zadejte, jaky chcete den (1 - 31): ');
repeat
gotoxy(36,6);for p:=1 to 40 do write(' ');
gotoxy(36,6);
readln(chci.den);
until (chci.den>0) and (chci.den<32);
writeln('Zadejte, jaky chcete den v tydnu');
writeln(' (0..nedele, 1..pondeli, 2..utery, 3..streda,');
write(' 4..patek, 5..sobota, 6..nedele): ');
repeat
gotoxy(39,9); for p:=1 to 40 do write(' ');
gotoxy(39,9);
readln(chci.dvt);
until (chci.dvt>-1) and (chci.dvt<7);
writeln;
textcolor(12);
kolik(chci.rok, chci.den, chci.dvt, dnes.rok, dnes.mesic, dnes.den, dnes.dvt);
if prestupny(chci.rok) then writeln('prestupny rok');
gotoxy(1,24);
textcolor(14);
writeln('Konec...Esc Pokracovat...ostatni klavesy');
klavesa:=readkey; if klavesa=#0 then klavesa:=readkey;
until klavesa=#27;
end.
Zpět