Задачи связанные с календарем., по материалам нашего форума Опции

[klem4]

1) Как вычислить конечную дату ?
Задача: У Васи Пупкина неожиданно сломался компьютер. Из-за отсутствия нужных материалов на ремонт понадобится N дней. Определите дату окончания ремонта, если известно, что компьютер сломался в текущем году, и ремонт должен закончиться тоже в этом году...

Function GetInteger(s: String): Integer;
 Var i, Err: Integer;
 Begin
   If s[1] = '0' Then Delete(s, 1, 1);
   Val(s, i, Err); GetInteger := i
 End;

Const
 CurrYear = 2004;
 DayInMonth: Array[1 .. 12] Of Byte =
   (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

(*
{ Тестировалось с этими данными }
Const
 Repair: Integer = 50;
 st: String = '21.06';
*)
Var
 Day, Month, DaysBefore: Integer;
 p, i: Byte;
Var
 Repair: Integer;
 st: String;
begin
 Inc(DayInMonth[2], Byte((CurrYear mod 4) = 0) and
                         not (((CurrYear mod 100) = 0) and ((CurrYear mod 400) <> 0));
 Write('Дата поломки > '); ReadLn(st);
 Write('Длительность ремонта > '); ReadLn(Repair);

 p := Pos('.', st);
 Day := GetInteger( Copy(st, 1, Pred(p)) );
 Month := GetInteger( Copy(st, Succ(p), Length(st)-p) );

 For i := 1 To Pred(Month) Do
   Inc(DaysBefore, DayInMonth[i]);
 Inc(DaysBefore, Day);

 Inc(DaysBefore, Repair);
 i := 1;
 While DaysBefore > DayInMonth[i] Do
   Begin
     Dec(DaysBefore, DayInMonth[i]); Inc(i)
   End;
 WriteLn('Ремонт закончится: ', DaysBefore, '.', i);
end.

by Volvo

Еще один вариант

program Lab8_02_2;
uses crt,dos;
var
 q:char;
 data:record
   day,year,months:word;
 end;
 j:integer;
 week:word;
 m:integer;
 g:word;

const
 month:array[1..12] of string[7] =
   ('января','февраля','марта','апреля','мая','июня','июля',
     'августа','сентябя','октября','ноября','декабря');
 a:array[1..12] of integer =
   (31,29,31,30,31,30,31,31,30,31,30,31);

begin
 repeat
   clrscr;
   getdate(data.year,data.months,data.day,week);
   g:=data.months;
   writeln('Сегодняшняя дата: ',data.day,' ',month[g]);
   writeln('введите число m через которое вы хотите узнать дату:');
   read(m);
   j:=m;
   while j<>0 do begin
     if j>a[data.months]-data.day then begin
       j:=j-(a[data.months]-data.day);
       inc(data.months);
       data.day:=0;
     end

     else begin
       data.day:=data.day+j; break;
     end;
   end;

   g:=data.months;
   writeln('Дата дня и месяц: ',data.day,' ',month[g] );
   write('Вычислить еще ?(Y/N)');
   q:=ReadKey;
 until not (q in ['Y','y']);
end.

by Amro

[klem4]

2) Задача про старокитайский календарь
В старокитайском календаре был принят 60-летний цикл состоящий из 5 двенадцатилетних подциклов. Подциклы обозначались названиями цвета:
• Зеленый
• Красный
• Желтый
• Белый
• Черный
Внутри каждого подцикла годы получили название животных:
• Крыса
• Корова
• Тигр
• Заяц
• Дракон
• Змея
• Лошадь
• Овца
• Обезьяна
• Курица
• Собака
• Свинья
(К примеру 1984–год зеленой крысы - был началом очередного цикла). Написать программу, которая вводит номер некоторого года нашей эры и печатает его название по старояпонскому календарю.

var

  y : array [0..11] of string =

  (
    'Rat',
    'Cow',
    'Tiger',
    'Rabbit',
    'Dragon',
    'Snake',
    'Horse',
    'Sheep',
    'Monkey',
    'Chicken',
    'Dog',
    'Pig'
  );

  d : array[0..4] of string =

  (
    'Green',
    'Red',
    'Yellow',
    'White',
    'Black'
  );


  year:Integer;

begin

   writeln('Input year'); readln(year);

   year := (year mod 60)-4;

   If year<0 then year := year+60;

   writeln(d[year div 12],' ',y[year mod 12]);

end.

by Idea