ru.algorithms

 
 - RU.ALGORITHMS ----------------------------------------------------------------
 From : Andrey Dashkovsky                    2:5002/46.4    14 Dec 2001  00:30:08
 To : All
 Subject : Определения дня недели
 -------------------------------------------------------------------------------- 
 

 Кому-то сабж нужен был, вот нарисовал сегодня на скорую руку, работает вроде.
 
 const
   days : array [0..6] of String[9] =
     ('Sunday','Monday','Tuesday',
      'Wednesday','Thursday','Friday',
      'Saturday');
   Days1: array [0..6] of String[9] =
     ('вс','пн','вт','ср','чт','пт','сб');
   MesStr:Array[1..12] of string[30]=('Январь','Февраль','Март','Апрель',
   'Май','Июнь','Июль','Август','Сентябрь','Октябрь','Hоябрь','Декабрь');
 const k_M1:Array[1..12] of byte=(31,28,31,30,31,30,31,31,30,31,30,31);
       k_M2:Array[1..12] of byte=(31,29,31,30,31,30,31,31,30,31,30,31);
       k_Y=365;
 function Vis(y:Integer):boolean;
 begin
  Vis:=(y mod 400=0)or(y mod 4=0)and(y mod 100<>0);
 end;
 function DayOfWeek(y,m,d:Integer):Byte;
 var y1, m1, d1, dow1 : Word;
     r:LongInt;
 begin
   GetDate(y1,m1,d1,dow1);
 {  Writeln('Today is ', days[dow1],', ',
           m1:0, '/', d1:0, '/', y1:0);}
   r:=d-d1;
   while m1>1 do
    begin
      if Vis(y1) then dec(R,k_m2[m1])
                 else dec(R,k_m1[m1]);
      dec(m1);
    end;
   while m>1 do
    begin
      if Vis(y) then inc(R,k_m2[m-1])
                else inc(R,k_m1[m-1]);
      dec(m);
    end;
  while y1<y do
   begin
    inc(r,365+byte(vis(y1)));
    inc(y1);
   end;
  while y1>y do
   begin
    dec(r,365+byte(vis(y1-1)));
    dec(y1);
   end;
  r:=r+dow1;
  r:=r mod 7;
  if r<0 then inc(r,7);
  DayOfWeek:=r;
 end;
 Andrey
 
 ... Рожденный ползать, пролезет везде...
 --- GoldED+/386 1.1.4.7
  * Origin: Всёфигня кроме пчёл,хотя пчёлы,еслиподумать,тоже фигня (2:5002/46.4)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор