_STRUCTURED PROGRAMMING COLUMN_
by Jeff Duntemann

[LISTING ONE]

{---------------------------------------------------}
{                    WHEN2.PAS                      }
{ A time-and-date stamp object for Turbo Pascal 6.0 }
{                           by Jeff Duntemann       }
{                           From DDJ for Jan. 1991  }
{ NOTE: This unit should be good until December 31, }
{ 2043, when the long integer time/date stamp turns }
{ negative.                                         }
{---------------------------------------------------}

UNIT When2;

INTERFACE

USES DOS;

TYPE
  String9  = STRING[9];
  String20 = STRING[20];
  String50 = STRING[50];

  When =
    OBJECT
      FUNCTION GetWhenStamp : LongInt;  { Returns 32-bit time/date stamp }
      FUNCTION GetTimeStamp : Word;     { Returns DOS-format time stamp }
      FUNCTION GetDateStamp : Word;     { Returns DOS-format date dtamp }
      FUNCTION GetYear      : Word;
      FUNCTION GetMonth     : Word;
      FUNCTION GetDay       : Word;
      FUNCTION GetDayOfWeek : Integer;  { 0=Sunday; 1=Monday, etc.  }
      FUNCTION GetHours     : Word;
      FUNCTION GetMinutes   : Word;
      FUNCTION GetSeconds   : Word;
      PROCEDURE PutNow;
      PROCEDURE PutWhenStamp(NewWhen  : LongInt);
      PROCEDURE PutTimeStamp(NewStamp : Word);
      PROCEDURE PutDateStamp(NewStamp : Word);
      PROCEDURE PutNewDate(NewYear,NewMonth,NewDay : Word);
      PROCEDURE PutNewTime(NewHours,NewMinutes,NewSeconds : Word);
    PRIVATE
      WhenStamp      : LongInt;      { Combined time/date stamp }
      TimeString     : String9;      { i.e., "12:45a"           }
      Hours,Minutes,Seconds : Word;  { Seconds is always even!  }
      DateString     : String20;     { i.e., "06/29/89"         }
      LongDateString : String50;     { i.e., "Thursday, June 29, 1989" }
      Year,Month,Day : Word;
      DayOfWeek      : Integer;      { 0=Sunday, 1=Monday, etc. }
      FUNCTION  CalcTimeStamp : Word;
      FUNCTION  CalcDateStamp : Word;
      FUNCTION  CalcDayOfWeek : Integer;  { via Zeller's Congruence }
      PROCEDURE CalcTimeString;
      PROCEDURE CalcDateString;
      PROCEDURE CalcLongDateString;
    END;

IMPLEMENTATION

{ Keep in mind that all this stuff is PRIVATE to the unit! }

CONST
  MonthTags : ARRAY [1..12] of String9 =
    ('January','February','March','April','May','June','July',
     'August','September','October','November','December');
  DayTags   : ARRAY [0..6] OF String9 =
    ('Sunday','Monday','Tuesday','Wednesday',
     'Thursday','Friday','Saturday');

TYPE
  WhenUnion =
    RECORD
      TimePart : Word;
      DatePart : Word;
    END;

VAR
  Temp1 : String50;
  Dummy : Word;

{***********************************************}
{ PRIVATE method implementations for type When: }
{***********************************************}

FUNCTION When.CalcTimeStamp : Word;

BEGIN
  CalcTimeStamp := (Hours SHL 11) OR (Minutes SHL 5) OR (Seconds SHR 1);
END;

FUNCTION When.CalcDateStamp : Word;

BEGIN
  CalcDateStamp := ((Year - 1980) SHL 9) OR (Month SHL 5) OR Day;
END;

PROCEDURE When.CalcTimeString;

VAR
  Temp1,Temp2 : String9;
  AMPM        : Char;
  I           : Integer;

BEGIN
  I := Hours;
  IF Hours = 0 THEN I := 12;   { "0" hours = 12am }
  IF Hours > 12 THEN I := Hours - 12;
  IF Hours > 11 THEN AMPM := 'p' ELSE AMPM := 'a';
  Str(I:2,Temp1); Str(Minutes,Temp2);
  IF Length(Temp2) < 2 THEN Temp2 := '0' + Temp2;
  TimeString := Temp1 + ':' + Temp2 + AMPM;
END;

PROCEDURE When.CalcDateString;

BEGIN
  Str(Month,DateString);
  Str(Day,Temp1);
  DateString := DateString + '/' + Temp1;
  Str(Year,Temp1);
  DateString := DateString + '/' + Copy(Temp1,3,2);
END;

PROCEDURE When.CalcLongDateString;

VAR
  Temp1 : String9;

BEGIN
  LongDateString := DayTags[DayOfWeek] + ', ';
  Str(Day,Temp1);
  LongDateString := LongDateString +
    MonthTags[Month] + ' ' + Temp1 + ', ';
  Str(Year,Temp1);
  LongDateString := LongDateString + Temp1;
END;

FUNCTION When.CalcDayOfWeek : Integer;

VAR
  Century,Holder : Integer;

FUNCTION Modulus(X,Y : Integer) : Integer;

VAR
  R : Real;

BEGIN
  R := X/Y;
  IF R < 0 THEN
    Modulus := X-(Y*Trunc(R-1))
  ELSE
    Modulus := X-(Y*Trunc(R));
END;

BEGIN
  { First test for error conditions on input values: }
  IF (Year < 0)  OR
     (Month < 1) OR (Month > 12) OR
     (Day < 1)   OR (Day > 31) THEN
     CalcDayOfWeek := -1  { Return -1 to indicate an error }
  ELSE
    { Do the Zeller's Congruence calculation as Zeller himself }
    { described it in "Acta Mathematica" #7, Stockhold, 1887.  }
    BEGIN
      { First we separate out the year and the century figures: }
      Century := Year DIV 100;
      Year    := Year MOD 100;
      { Next we adjust the month such that March remains month #3, }
      {  but that January and February are months #13 and #14,     }
      {  *but of the previous year*: }
      IF Month < 3 THEN
        BEGIN
          Inc(Month,12);
          IF Year > 0 THEN Dec(Year,1)      { The year before 2000 is }
            ELSE                            { 1999, not 20-1...       }
              BEGIN
                Year := 99;
                Dec(Century);
              END
        END;

      { Here's Zeller's seminal black magic: }
      Holder := Day;                        { Start with the day of month }
      Holder := Holder + (((Month+1) * 26) DIV 10); { Calc the increment }
      Holder := Holder + Year;              { Add in the year }
      Holder := Holder + (Year DIV 4);      { Correct for leap years  }
      Holder := Holder + (Century DIV 4);   { Correct for century years }
      Holder := Holder - Century - Century; { DON'T KNOW WHY HE DID THIS! }

      Holder := Modulus(Holder,7);          { Take Holder modulus 7  }

      { Here we "wrap" Saturday around to be the last day: }
      IF Holder  = 0 THEN Holder := 7;

      { Zeller kept the Sunday = 1 origin; computer weenies prefer to }
      { start everything with 0, so here's a 20th century kludge:     }
      Dec(Holder);

      CalcDayOfWeek := Holder;  { Return the end product! }
    END;
END;

{**********************************************}
{ PUBLIC method implementations for type When: }
{**********************************************}

FUNCTION When.GetWhenStamp : LongInt;

BEGIN
  GetWhenStamp := WhenStamp;
END;

FUNCTION When.GetTimeStamp : Word;

BEGIN
  GetTimeStamp := WhenUnion(WhenStamp).TimePart;
END;

FUNCTION When.GetDateStamp : Word;

BEGIN
  GetDateStamp := WhenUnion(WhenStamp).DatePart;
END;

FUNCTION When.GetYear : Word;

BEGIN
  GetYear := Year;
END;

FUNCTION When.GetMonth : Word;

BEGIN
  GetMonth := Month;
END;

FUNCTION When.GetDay : Word;

BEGIN
  GetDay := Day;
END;

FUNCTION When.GetDayOfWeek : Integer;

BEGIN
  GetDayOfWeek := DayOfWeek;
END;

FUNCTION When.GetHours   : Word;

BEGIN
  GetHours := Hours;
END;

FUNCTION When.GetMinutes : Word;

BEGIN
  GetMinutes := Minutes;
END;

FUNCTION When.GetSeconds : Word;

BEGIN
  GetSeconds := Seconds;
END;

{---------------------------------------------------------------------}
{ To fill a When record with the current time and date as maintained  }
{ by the system clock, execute this method:                           }
{---------------------------------------------------------------------}

PROCEDURE When.PutNow;

BEGIN
  { Get current clock time.  Note that we ignore hundredths figure: }
  GetTime(Hours,Minutes,Seconds,Dummy);
  { Calculate a new time stamp and update object fields: }
  PutTimeStamp(CalcTimeStamp);
  GetDate(Year,Month,Day,Dummy); { Get current clock date }
  { Calculate a new date stamp and update object fields: }
  PutDateStamp(CalcDateStamp);
END;

{---------------------------------------------------------------------}
{ This method allows us to apply a whole long integer time/date stamp }
{ such as that returned by the DOS unit's GetFTime procedure to the   }
{ When object.  The object divides the stamp into time and date       }
{ portions and recalculates all other fields in the object.           }
{---------------------------------------------------------------------}

PROCEDURE When.PutWhenStamp(NewWhen  : LongInt);

BEGIN
  WhenStamp := NewWhen;
  { We've actually updated the stamp proper, but we use the two }
  { "put" routines for time and date to generate the individual }
  { field and string representation forms of the time and date. }
  { I know that the "put" routines also update the long integer }
  { stamp, but while unnecessary it does no harm.               }
  PutTimeStamp(WhenUnion(WhenStamp).TimePart);
  PutDateStamp(WhenUnion(WhenStamp).DatePart);
END;

{---------------------------------------------------------------------}
{ We can choose to update only the time stamp, and the object will    }
{ recalculate only its time-related fields.                           }
{---------------------------------------------------------------------}

PROCEDURE When.PutTimeStamp(NewStamp : Word);

BEGIN
  WhenUnion(WhenStamp).TimePart := NewStamp;
  { The time stamp is actually a bitfield, and all this shifting left }
  { and right is just extracting the individual fields from the stamp:}
  Hours := NewStamp SHR 11;
  Minutes := (NewStamp SHR 5) AND $003F;
  Seconds := (NewStamp SHL 1) AND $001F;
  { Derive a string version of the time: }
  CalcTimeString;
END;

{---------------------------------------------------------------------}
{ Or, we can choose to update only the date stamp, and the object     }
{ will then recalculate only its date-related fields.                 }
{---------------------------------------------------------------------}

PROCEDURE When.PutDateStamp(NewStamp : Word);

BEGIN
  WhenUnion(WhenStamp).DatePart := NewStamp;
  { Again, the date stamp is a bit field and we shift the values out  }
  { of it: }
  Year := (NewStamp SHR 9) + 1980;
  Month := (NewStamp SHR 5) AND $000F;
  Day := NewStamp AND $001F;
  { Calculate the day of the week value using Zeller's Congruence:    }
  DayOfWeek := CalcDayOfWeek;
  { Calculate the short string version of the date; as in "06/29/89": }
  CalcDateString;
  { Calculate a long version, as in "Thursday, June 29, 1989": }
  CalcLongDateString;
END;

PROCEDURE When.PutNewDate(NewYear,NewMonth,NewDay : Word);

BEGIN
  { The "boss" field is the date stamp.  Everything else is figured }
  { from the stamp, so first generate a new date stamp, and then    }
  { (odd as it may seem) regenerate everything else, *including*    }
  { the Year, Month, and Day fields: }
  PutDateStamp(CalcDateStamp);
  { Calculate the short string version of the date; as in "06/29/89": }
  CalcDateString;
  { Calculate a long version, as in "Thursday, June 29, 1989": }
  CalcLongDateString;
END;

PROCEDURE When.PutNewTime(NewHours,NewMinutes,NewSeconds : Word);

BEGIN
  { The "boss" field is the time stamp.  Everything else is figured }
  { from the stamp, so first generate a new time stamp, and then    }
  { (odd as it may seem) regenerate everything else, *including*    }
  { the Hours, Minutes, and Seconds fields: }
  PutTimeStamp(CalcTimeStamp);
  { Derive the string version of the time: }
  CalcTimeString;
END;

END.