===========================================================================
 BBS: The Beta Connection
Date: 06-07-93 (00:10)             Number: 773
From: CYRUS PATEL                  Refer#: 744
  To: STEPHEN WHITIS                Recvd: NO  
Subj: DATE CALCULATIONS              Conf: (232) T_Pascal_R
---------------------------------------------------------------------------
SW>Does anyone know where I can find an algorithm, or better yet TP
SW>5.5 code, to calculate the day of the week for a give date?

Here's TP source for day of the week...

Const
   CurrentYear = 1900;

Type
   DateStr: String[8];


Procedure ConvDate(DateStr: DateRecord;
                   Var Month, Day, Year: Word);

 {this converts the date from string to numbers for month, day, and year}

  Var
    ErrorCode: Integer;

  Begin
    Val(Copy(DateStr, 1, 2), Month, ErrorCode);
    Val(Copy(DateStr, 4, 2), Day, ErrorCode);
    Val(Copy(DateStr, 7, 2), Year, ErrorCode);
    Year := Year + CurrentYear
  End;


Function Dow(DateStr: DateRecord): Byte;

   {this returns the Day Of the Week as follows:
         Sunday is 1, Monday is 2, etc...  Saturday is 7}

  Var
    Month, Day, Year, Y1, Y2: Word;

  Begin
    ConvDate(DateStr, Month, Day, Year);
    If Month < 3 then
      Begin
      Month := Month + 10;
      Year := Year - 1
      End
    else
      Month := Month - 2;
    Y1 := Year Div 100;
    Y2 := Year Mod 100;
    Dow := ((Day + Trunc(2.6 * Month - 0.1) + Y2 + Y2 Div 4 + Y1 Div 4 - 2 *
           Y1 + 49) Mod 7) + 1
  End;


Here's an example of how to use it...

Begin
   Case Dow('06/06/93') of
     1: Write('Sun');
     2: Write('Mon');
     3: Write('Tues');
     4: Write('Wednes');
     5: Write('Thurs');
     6: Write('Fri');
     7: Write('Satur')
   End;
   WriteLn('day')
End.


SW>And I just know I've run across an algorithm or code to do this
SW>before, but it was a while back, and I've looked in the places I
SW>thought it might have been.  Any ideas?

You might want to take a look at Dr. Dobbs from a few months back
(earlier this year), they had an whole issue related to dates

Cyrus
---
 þ SPEED 1ú30 #666 þ 2!  4!  6!  8!  It's time to calculate!  2 24 720 40,32
 * Midas Touch of Chicago 312-764-0591/0761 DUAL STD
 * PostLink(tm) v1.06  MIDAS (#887) : RelayNet(tm) Hub