home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / calendar / calfuncs.inc < prev    next >
Encoding:
Text File  |  1985-07-01  |  1.6 KB  |  45 lines
  1. Function LeapYear(Year:Integer):Byte;
  2. Begin
  3.      If (((Year Mod 400)=0) Or (((Year Mod 4)=0) And ((Year Mod 100)<>0))) Then
  4.      LeapYear:=1 Else LeapYear:=0;
  5. End;
  6.  
  7. Function DayOfYear(Year, Month, Day : Integer) : Integer;
  8. Begin
  9.      DayOfYear:=Trunc(Int(3055.0*(Month+2.0)/100.0)
  10.                -Int((Month+10.0)/13.0)*2-91
  11.                +(LeapYear(Year)*Int((Month+10.0)/13.0)
  12.                +Day));
  13. End;
  14.  
  15. Function RealMod(x:Real;y:Integer):Integer;   {-------------------------}
  16. Begin                                         {Turbo MOD operator only  }
  17.      RealMod:=Trunc(x-Int(x/y)*y+0.5);        {works with Integer values}
  18. End;                                          { This is same operation  }
  19.                                               {For real argument.       }
  20.                                               {-------------------------}
  21.  
  22. Function RealDay(Year,Month,Day : Integer) : Real;
  23. Begin
  24.      RealDay:=DayOfYear(Year,Month,Day)
  25.              +((Year-1)*365.0)
  26.              +Int((Year-1)/4)
  27.              -Int((Year-1)/100)
  28.              +Int((Year-1)/400);
  29. End;
  30.  
  31. Function DayOfWeek(Year,Month,Day : Integer) : Integer;
  32. Begin                                                       {0 is Sunday}
  33.      DayOfWeek:=RealMod(RealDay(Year,Month,Day),7)
  34. End;
  35.  
  36. Procedure GetMonthDay(Year, DayOfYear : Integer; Var Month,Day : Integer);
  37. Var
  38.     Temp : Integer;
  39.     Leap : Byte;
  40. Begin
  41.      Leap:=LeapYear(Year);
  42.      Temp:=Trunc(DayOfYear+Int((305+DayOfYear-Leap)/365)*(2-Leap));
  43.      Month:=Trunc(Int(((Temp+91.0)*100.0)/3055.0)-2.0);
  44.      Day:=Trunc(Temp+30.0-Int((Month*3056.0)/100.0));
  45. End;