Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Pascal Форум Информер Страны мира
   Дата и Время    >>    kalendar
   
 
 Вечный календарь на год   Sergey Shcherbakov 06.08.1997

Программа печатает на экран календарь на любой год.



1k 
 

- 4INT ------------------------------------------ It's interesting - Msg : 92 of 200 Addr Date From : Sergey Shcherbakov 2:463/357.5 06.08.97 Subj : Вечный календарь на год -------------------------------------------------------------------- Рад приветствовать Sergey ! Понедельник Август 04 1997, 15:21 - Sergey Zaikov пиcали к All: SZ> А не завалялись ли у кого-нибудь исходники subj ??? SZ> (язык пpогpаммиpования значения не имеет) Вот на весь год. SZ> Заpанее благодаpен, Sergey. До свидания, Sergey. --- Жадный Голый Дед - III * Origin: А хотя бы и жадный - Зато от чистого сердца. :) (2:463/357.5) --- Program kalendar; uses crt; const kd:array[1..7] of string=('пн','вт','ср','чт','пт','сб','вс'); month:array[1..12] of string=('январь','февраль','март','апрель','май', 'июнь','июль','август','сентябрь','октябрь','ноябрь','декабрь'); days:array [1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31); var year:word; i,j,d,t:byte; Begin clrscr;writeln('введите год'); read(year);clrscr; d:=(2+(year-1901)+(year-1901) div 4); d:=d mod 7; if d=0 then d:=7; for i:=1 to 3 do begin for j:=1 to 7 do begin gotoxy(1,i+j+(i-1)*7); write(kd[j]) end; for j:=1 to 4 do begin gotoxy(wherex+8,wherey-7); write(month[j+4*(i-1)]); gotoxy(wherex-6-length(month[j+4*(i-1)]),wherey+d); if year mod 4=0 then days[2]:=29; for t:=1 to days[j+(i-1)*4] do begin {----------} if ((wherey-1) mod 8=7) then TextColor(LightRed); write(t); TextColor(LightGray); {----------} if d+1=8 then begin if (t>=1) and (t<9) then gotoxy(wherex+2,wherey-6) else gotoxy(wherex+1,wherey-6); d:=1;end else begin d:=d+1; if (t>=1) and (t<9) then gotoxy(wherex-1,i+(i-1)*7+d) else gotoxy(wherex-2,i+(i-1)*7+d); end; end; gotoxy(wherex+3,i+i*7); end end ; readln; End.