1801-2199 Yılları Arası Takvim Programı

program takvim;
uses wincrt;
label tekrar,aynoal;
const
aylar:array[1..12] of string[9]=
('OCAK','ŞUBAT','MART','NİSAN','MAYIS','HAZİRAN','TEMMUZ','AĞUSTOS','EYLÜL','EKİM','KASIM','ARALIK');
gunler:array[0..6] of string[3]=('PAZAR','PAZARTESİ','SALI','ÇARŞAMBA','PERŞEMBE','CUMA','CUMARTESİ');
topgun:array[1..12] of integer=(0,31,59,90,120,151,181,212,243,273,304,334);
aygunsay:array[1..12] of integer=(31,28,31,30,31,30,31,31,30,31,30,31);
sutno:array[0..6] of integer=(15,23,31,39,47,55,63);
type
st70=string[70];
var
syil:string[4];
yaz:string[20];
ay,gun,yr,y,c,cn,d,l,sut,yil,jgun,artik:integer;
tus:char;
procedure yildiz(n:integer);
var l:integer;
begin for l:=1 to n do
write('*');
end;
procedure bosluk(n:integer);
var l:integer;
begin for l:=1 to n do
write(' ');
end;
procedure gunyaz(x:integer;s:st70);
begin gotoxy(sutno[x],sut);write(s);
end;
procedure ayyaz(x:integer;s:st70);
begin gotoxy(x,4);write(s);
end;
procedure gyaz(x,daycount:integer);
begin if x=0 then sut:=sut+2;
gotoxy(sutno[x],sut);write(daycount:2);
end;
procedure ilkgunbul(m,yr:integer);
begin
y:=yr-1801;c:=trunc((yr-1)/100);
cn:=trunc(yr/100);
d:=(5+y+trunc(y/4)-(c-18)+trunc((c-16)/4))mod 7;
if yr mod 4=0 then artik:=1 else artik:=0;
jgun:=topgun[m]+1;if m>2 then
jgun:=jgun+artik;
d:=d+(jgun mod 7);
end;
{************************** ANA PROGRAM ********************************}
begin
tekrar:
clrscr;
gotoxy(0,22);writeln('lÜTFEN 1801-2199 ARASI BİR YIL GİRİN');
gotoxy(35,30);
write('YIL:');
readln(yil);
if (yil>=0) and (yil<100) then yil:=yil+1900;
str(yil,syil);
gotoxy(1,23);
clreol;
if (yil<1801) or (yil>2199) then
begin
writeln('HATA!! LÜTFEN YENİDEN YIL GİRİN...');
goto tekrar;
end;
aynoal:
gotoxy(35,32);
write('AYI GİRİN:');
readln(ay);
gotoxy(1,24);
clreol;
if (ay<0) or (ay>12) then
begin
writeln('HATA!! LÜTFEN YENİDEN AY GİRİN...');
goto aynoal;
end;
clrscr;
gotoxy(28,2);
writeln;
bosluk(5);
yildiz(70);writeln;
bosluk(5);
yildiz(9);
bosluk(18);
write(copy(syil,1,1));
bosluk(4);
write(copy(syil,2,1));
bosluk(4);
write(copy(syil,3,1));
bosluk(4);
write(copy(syil,4,1));
bosluk(18);
yildiz(9);writeln;
sut:=6;
bosluk(5);
yildiz(70);writeln;
bosluk(5);
yildiz(2);
bosluk(66);
yildiz(2);writeln;
for l:=1 to 13 do
begin
gotoxy(6,6+l);yildiz(2);
gotoxy(74,6+l);yildiz(2);
end;
gotoxy(6,20);yildiz(70);
writeln;
ilkgunbul(ay,yil);
for l:=0 to 6 do
gunyaz(l,gunler[l]); writeln;
bosluk(5);yildiz(70);writeln;
sut:=9;
l:=length(aylar[ay]);
ayyaz(17,aylar[ay]);
ayyaz(65-l,aylar[ay]);
l:=aygunsay[ay];
if ay=2 then l:=l+artik;
for c:=1 to l do
begin cn:=(d+c-3) mod 7;
if cn<0 then cn:=cn+7;
gyaz(cn,c);
end;
gotoxy(4,24);write('BU PROGRAMI YAZAN GÖZDE KORKMAZ.');
gotoxy(25,60);clreol;
write('DEVAM ETMEK İSTERMİSİNİZ [Y/N]');
repeat
tus:=readkey;
until upcase(tus) in ['Y','N'];
if upcase(tus)='Y' then
goto tekrar;
end.