На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
  
    > выходные дни в указанном году
      На Администратора надейся, да и сам не плошай! Когда время поджимает, приходится включать свою тарахтелку :)) Может, кому пригодится. Кривость кода - извиняйте.

      // Функция вычисляет число дней в году (работает с 2004 по 2052 г)
      Function Day_in_Year (Year : integer) : integer;
      var i1, i : integer;
      begin
      i1 := 2004;
      for i := 1 to 22 do
      begin
      if Year = i1 then
      begin
      Result := 366;
      exit;
      end;
      i1 := i1 + 4;
      end;
      Result := 365;
      end;

      procedure TForm1.Button1Click(Sender: TObject);
      var i, Count, i2 : integer;
      D, M, Y : word;
      begin
      Count := 0; // Сюда запишем количество выходных дней
      Y := SpinEdit1.Value; // Требуемый год (вводится пользователем)
      // Определяем, сколько дней в месяце 2
      if Day_in_Year(Y) = 365 then i2 := 28 else i2 := 29;
      For i := 1 to 31 do
      begin
      // Для месяцев 1, 3, 5, 7, 8, 10, 12
      // День недели 1 - воскресенье; 7 - суббота (SysUtils)
      if (DayOfWeek(EncodeDate(Y,1,i)) = 1) or (DayOfWeek(EncodeDate(Y,1,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,3,i)) = 1) or (DayOfWeek(EncodeDate(Y,3,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,5,i)) = 1) or (DayOfWeek(EncodeDate(Y,5,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,7,i)) = 1) or (DayOfWeek(EncodeDate(Y,7,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,8,i)) = 1) or (DayOfWeek(EncodeDate(Y,8,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,10,i)) = 1) or (DayOfWeek(EncodeDate(Y,10,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,12,i)) = 1) or (DayOfWeek(EncodeDate(Y,12,i)) = 7) then Count := Count + 1;
      // Для месяцев 4, 6, 9, 11
      if i <> 31 then
      begin
      if (DayOfWeek(EncodeDate(Y,4,i)) = 1) or (DayOfWeek(EncodeDate(Y,4,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,6,i)) = 1) or (DayOfWeek(EncodeDate(Y,6,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,9,i)) = 1) or (DayOfWeek(EncodeDate(Y,9,i)) = 7) then Count := Count + 1;
      if (DayOfWeek(EncodeDate(Y,11,i)) = 1) or (DayOfWeek(EncodeDate(Y,11,i)) = 7) then Count := Count + 1;
      end;
      // Для месяца 2
      if i <= i2 then
      if (DayOfWeek(EncodeDate(Y,2,i)) = 1) or (DayOfWeek(EncodeDate(Y,2,i)) = 7) then Count := Count + 1;
      end;
      // Теперь просмотрим праздники
      If (DayOfWeek(EncodeDate(Y,1,1)) <> 1) and (DayOfWeek(EncodeDate(Y,1,1)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,1,2)) <> 1) and (DayOfWeek(EncodeDate(Y,1,2)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,1,7)) <> 1) and (DayOfWeek(EncodeDate(Y,1,7)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,2,23)) <> 1) and (DayOfWeek(EncodeDate(Y,2,23)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,3,8)) <> 1) and (DayOfWeek(EncodeDate(Y,3,8)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,5,1)) <> 1) and (DayOfWeek(EncodeDate(Y,5,1)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,5,2)) <> 1) and (DayOfWeek(EncodeDate(Y,5,2)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,5,9)) <> 1) and (DayOfWeek(EncodeDate(Y,5,9)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,6,12)) <> 1) and (DayOfWeek(EncodeDate(Y,6,12)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,11,7)) <> 1) and (DayOfWeek(EncodeDate(Y,11,7)) <> 7) then Count := Count + 1;
      If (DayOfWeek(EncodeDate(Y,12,12)) <> 1) and (DayOfWeek(EncodeDate(Y,12,12)) <> 7) then Count := Count + 1;

      Label1.Caption := IntToStr(Count); // Результат!
      end;
        Гениально..
          Нобелевку надо выдавать
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script Execution time: 0,0720 ]   [ 17 queries used ]   [ Generated: 24.08.19, 02:34 GMT ]