Programalama > PASCAL

program takvim;

uses crt;

label tekrar,aynoal;

const

     aylar:array[1..12] of string[9]=

     ('OCAK','SUBAT','MART','NISAN','MAYIS','HAZIRAN','TEMMUZ','AGUSTOS','EYLUL',

     'EKIM','KASIM','ARALIK');

     gunler:array[0..6] of string[3]=('Paz','Pzt','Sal','Crs','Prs','Cum','Cmt');

     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:
     textbackground(4);
     clrscr;

     highvideo;

     gotoxy(20,22);writeln('LUTFEN 1801-2199 ARASINDA BIR YIL GIRINIZ :');

     gotoxy(30,30);

     write('LUTFEN YILI GIRINIZ : ');

     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

          gotoxy(25,34);writeln('HATA!! LUTFEN YILI TEKRAR GIRINIZ...');
     
	delay(1000);

          goto tekrar;

     end;

     aynoal:
	  
          gotoxy(30,54);writeln('                                   ');
	  
	  gotoxy(25,34);writeln('                                   ');  


     gotoxy(30,32);

     write('LUTFEN AYI GIRINIZ : ');

     gotoxy(30,54);readln(ay);

     gotoxy(1,24);

     clreol;

     if (ay<0) or (ay>12) then

     begin

	  gotoxy(25,34);writeln('HATA!! LUTFEN AYI TEKRAR GIRINIZ...');
     
	delay(1000);

          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(14,24);write('DESIGNED BY shimseqh!.');

         gotoxy(38,60);clreol;

         write('DEVAM ETMEK ISTIYORMUSUNUZ [Y/N]');

         repeat

               tus:=readkey;

         until  upcase(tus) in ['Y','N'];

         if upcase(tus)='Y' then

         goto tekrar;

end.

Türkçeleştiren shimseqh!

shimseqh
shimseqh_76@hotmail.com