POINT Software Programming/PPROG1.ISO/pascal/visionix/vdatesu.pas

Pascal/Delphi Source File | 1993-12-29 | 65.0 KB | 3,353 lines

{
 ════════════════════════════════════════════════════════════════════════════

 Visionix Date Functions Unit (VDATES)
   Version 0.12
 Copyright 1991,92,93 Visionix
 ALL RIGHTS RESERVED

 ────────────────────────────────────────────────────────────────────────────

 Revision history in reverse chronological order:

 Initials  Date      Comment
 ────────  ────────  ────────────────────────────────────────────────────────

 jrt       12/06/93  Added SwatchExpired

 mep       11/25/93  Added Unix date functions.

 mep       11/19/93  Total rewriting of unit.  Much easier to use now.

 lpg       03/21/93  Changed: TDateTime -> TDTime, DateTime -> TDateTime.

 lpg       03/13/93  Added Source Documentation

 mep       02/11/93  Cleaned up code for beta release

 jrt       02/08/93  Sync with beta 0.12 release

 lpg       01/13/93  Added: ValidDateTime

 mep       12/18/92  Added: TimeToStrHM and DateToStrDay for VCopy use.

 jrt       12/07/92  Sync with beta 0.11 release

 lpg       11/24/92  Modified & corrected DT functions,

 jrt       11/21/92  Sync with beta 0.08

 lpg       10/23/92  Made more Functions & Tested

 lpg       10/19/92  Created

 ════════════════════════════════════════════════════════════════════════════
}

(*-

[TEXT]

<Overview>

VDATES is the collection of various date and time functions.  Some features
include:

  ■ Day of week, Leap Year, Days in month, and Daylight Savings.

  ■ Type validations.

  ■ DateTime (from DOS unit) is now called TDateTime (for Windows compat.).

  ■ TDateTime inc, dec, add, sub, and absolution difference.

  ■ Julian date <--> DateTime conversions (for your Date-math functions).

  ■ Packed DateTime extractions and conversions.

  ■ Stop Watch (TSwatch) for the time-of-day in seconds (with 100th second
    accuracy).  TSwatch also has inc, dec, add, sub, and distance functions.

  ■ System Clock functions: clock ticks since midnight, setting system
    date and time, setting system alarm (these work with BCD parameters).

  ■ and much more...

<Interface>

-*)

Unit VDatesu;

Interface

{──────────────────────────────────────────────────────────────────────────}

Uses

  VTypesu,
  VGenu,
  VStringu,
  DOS;

{──────────────────────────────────────────────────────────────────────────}

Const

  {-----------------------------------}
  { Constants for Date/Time functions }
  {-----------------------------------}

  cdt100sInDay = 8640000;

  cdtSecsInDay = 86400;          { Number of seconds per day }

  cdtSecsInHour = 3600;

  cdtDaysInMonth : Array[1..12] of BYTE =
    (31,28,31,30,31,30,31,31,30,31,30,31);

  cdtYearBase  : WORD = 1980;    { The assumed beginning year for functions }

  cdtDayStr    : Array[0..6] of String[15] =
                 ( 'Sunday',   'Monday', 'Tuesday', 'Wednesday',
                   'Thursday', 'Friday', 'Saturday' );

  cdtMonthStr  : Array[1..12] of String[12] =
                 ( 'January',   'February', 'March',    'April',
                   'May',       'June',     'July',     'August',
                   'September', 'October',  'November', 'December' );

  cdtDateTimeMask : STRING = 'WWW  $MMM D+, $Y+  HH:II:SS';

  cdtSwatchMask   : STRING = 'HH:II:SS.1+';

  cdtUnixBase     = 2440588; { Julian days for 1/1/1970 }




Type

  {---------------------------------------------------------------}
  { Since TPW redefines DateTime (DOS.TPU) to TDateTime, use this }
  { instead of DateTime (for compatibility).                      }
  {---------------------------------------------------------------}

{$IFNDEF TDateTime}

  TDateTime    = DateTime;

{$ENDIF}

  TDateTimeEx  = RECORD    { DateTime type with extensions }

    Year       : WORD;
    Month      : WORD;
    Day        : WORD;
    DOW        : WORD;
    Hour       : WORD;
    Min        : WORD;
    Sec        : WORD;
    Sec100     : WORD;

  END;

  TPackedDT    = LONGINT; { Packed TDateTime (4-bytes as used in DOS) }

  TSwatch      = REAL;  { StopWatch in seconds (decimal is 100th seconds) }

  TJulian      = LONGINT; { Linear date system (for calendar math) }

  TUnixDT      = LONGINT; { Seconds since Jan 1, 1970  12:00:00 AM }

{════════════════════════════════════════════════════════════════════════════}


{-----------------}
{ Basic Functions }
{-----------------}

Function  DayOfWeek(              DT             : TDateTime ) : WORD;

Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;

Function  LeapYearDays(           Year           : WORD      ) : INTEGER;

Function  DaysInMonth(            Month          : WORD;
                                  Year           : WORD      ) : INTEGER;

Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;

Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;

Function  CompleteYear(           Year           : WORD      ) : WORD;

Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
                                  MaskStr        : STRING    ) : STRING;

{---------------------}
{ Validation of Types }
{---------------------}

Function  ValidDate(              Year           : WORD;
                                  Month          : WORD;
                                  Day            : WORD      ) : BOOLEAN;

Function  ValidTime(              Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD      ) : BOOLEAN;

Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;

Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;

Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;


{---------------------}
{ TDateTime Functions }
{---------------------}

Procedure CurrDateTime(       Var DT             : TDateTime );

Function  DateTimeStr(            DT             : TDateTime ) : STRING;

Function  DateTimeMaskStr(        DT             : TDateTime;
                                  Mask           : STRING    ) : STRING;

Procedure IncDateTime(        Var DT             : TDateTime );

Procedure DecDateTime(        Var DT             : TDateTime );

Procedure AddDateTime(            DTAdd          : TDateTime;
                              Var DT             : TDateTime );

Procedure SubDateTime(            DTSub          : TDateTime;
                              Var DT             : TDateTime );

Procedure DateTimeDiff(           DT1            : TDateTime;
                                  DT2            : TDateTime;
                              Var DTDiff         : TDateTime );

Procedure ExToDateTime(           DTEx           : TDateTimeEx;
                              Var DT             : TDateTime   );

Procedure DateTimeToEx(           DT             : TDateTime;
                              Var DTEx           : TDateTimeEx );

Function  DTtoJulian(             DT             : TDateTime ) : TJulian;

Procedure JulianToDT(             J              : TJulian;
                              Var DT             : TDateTime );


Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;

Procedure SwatchToDT(             Swatch         : TSwatch;
                              Var DT             : TDateTime );

Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;

Procedure UnixToDT(               UnixDT         : TUnixDT;
                              Var DT             : TDateTime );

{---------------------------}
{ Packed DateTime Functions }
{---------------------------}

Function  CurrPackedDT                                         : TPackedDT;

Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;

Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;


{------------------}
{ Swatch Functions }
{------------------}

Function  CurrSwatch                                           : TSwatch;

Function  HMS1ToSwatch(           Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD;
                                  Sec100         : WORD      ) : TSwatch;

Procedure SwatchToHMS1(           Swatch         : TSwatch;
                              Var Hour           : WORD;
                              Var Min            : WORD;
                              Var Sec            : WORD;
                              Var Sec100         : WORD      );

Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;

Function  SwatchMaskStr(          Swatch         : TSwatch;
                                  Mask           : STRING    ) : STRING;

Function  AddSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

Function  SubSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

Procedure SwatchDiff(             Swatch1        : TSwatch;
                                  Swatch2        : TSwatch;
                              Var Hours          : WORD;
                              Var Mins           : WORD;
                              Var Secs           : WORD;
                              Var Sec100s        : WORD      );

Function  SwatchExpired(          Swatch1        : TSwatch;
                                  Expire100s     : LONGINT   ) : BOOLEAN;

{------------------------}
{ System Clock Functions }
{------------------------}

Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;

Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;


Function SetSysTime(              BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE;
                                  DSTActive      : BOOLEAN   ) : BOOLEAN;

Function GetSysTime(          Var BCDHours       : BYTE;
                              Var BCDmins        : BYTE;
                              Var BCDSecs        : BYTE;
                              Var DSTActive      : BOOLEAN   ) : BOOLEAN;

Function SetSysDate(              BCDDay         : BYTE;
                                  BCDMon         : BYTE;
                                  BCDYear        : BYTE;
                                  BCDCent        : BYTE      ) : BOOLEAN;

Function GetSysDate(          Var BCDDay         : BYTE;
                              Var BCDMon         : BYTE;
                              Var BCDYear        : BYTE;
                              Var BCDCent        : BYTE      ) : BOOLEAN;

Function SetSysAlarmOn(           BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE      ) : BOOLEAN;

Function SetSysAlarmOff                                        : BOOLEAN;


Procedure Sleep(                  Sleep100s      : LONGINT   );

{════════════════════════════════════════════════════════════════════════════}

Implementation

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DayOfWeek(              DT             : TDateTime ) : WORD;

[PARAMETERS]

DT          TDateTime (only Date part is important)

[RETURNS]

Day of week (0 = Sunday to 6 = Saturday)

[DESCRIPTION]

Finds out the day of the week from the given date.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DayOfWeek(              DT             : TDateTime ) : WORD;

Var

  Julian : TJulian;

BEGIN

  DayOfWeek := Succ(DTtoJulian(DT)) MOD 7;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;

[PARAMETERS]

Year        Source Year

[RETURNS]

Whether the source year is a leap year.

[DESCRIPTION]

Will return true if given year is a "leap year".

[SEE-ALSO]

[EXAMPLE]

-*)

Function  IsLeapYear(             Year           : WORD      ) : BOOLEAN;

BEGIN

  IsLeapYear := ( ( ( Year MOD 4 = 0 ) AND
                    ( Year MOD 100 <> 0 ) ) OR
                  ( Year MOD 400 = 0 ) );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  LeapYearDays(           Year           : WORD      ) : INTEGER;

[PARAMETERS]

Year        Source Year

[RETURNS]

Number of days in leap year.

[DESCRIPTION]

Calculates the extra number of days in a given year (by figuring leap
year and century).  A no-leap year will be 0, a leap year will be 1, and
a leap century will be 2.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  LeapYearDays(           Year           : WORD      ) : INTEGER;

Var

  Days : INTEGER;

BEGIN

  Days := 0;

  If (Year MOD 4 = 0) AND (Year MOD 100 <> 0) Then
    Inc(Days);

  LeapYearDays := Days;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DaysInMonth(            Month          : WORD;
                                  Year           : WORD      ) : INTEGER;

[PARAMETERS]

Month       Source Month
Year        Source Year

[RETURNS]

Number of Days in the Source Month.

[DESCRIPTION]

Based upon the provided Month and Year, returns the number of days that
are in that month.  This takes into account Leap Year Days for Feberuary.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DaysInMonth(            Month          : WORD;
                                  Year           : WORD      ) : INTEGER;

BEGIN

  If (Month = 2) Then
    DaysInMonth := cdtDaysInMonth[2] + Byte(LeapYearDays(Year))
  Else
    DaysInMonth := cdtDaysInMonth[Month];

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;

[PARAMETERS]

DT          Source Date and Hour

[RETURNS]

Returns whether DayLight Savings is in effect.

[DESCRIPTION]

Per an Act of Congress of 1986, the Spring Change Day was set to be
the 1st Sunday in April with the Fall Change Day being the the last
Sunday in October.  Prior to this the Spring Change Day was the last
Sunday in April.

Per this Act, individual states and areas were free to elect to use
DayLight Savings or not.  Some of the areas which have Elected not to
are Arizona, Hawaii, Peurto Rico, the Virgin Islands, the American
Samoas, and part of the following States: Indiana, Kansas, Texas,
Florida, Michigan, and Alaska.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  IsDayLightSavings(      DT             : TDateTime ) : BOOLEAN;

Const

  SpringMonth = 4;
  FallMonth   = 10;
  ChangeHour  = 2;  { 2 AM }

Var

  DLS     : BOOLEAN;
  DT2     : TDateTime;
  ThisDay : INTEGER;

BEGIN

  If ( (DT.Month < SpringMonth) or (DT.Month > FallMonth) ) Then
    DLS := FALSE
  Else

  If ( (DT.Month > SpringMonth) And (DT.Month < FallMonth) ) Then
    DLS := TRUE
  Else

  If (DT.Month = SpringMonth) Then
  BEGIN

    {-------------------}
    { Find first Sunday }
    {-------------------}

    DT2     := DT;
    DT2.Day := 1;

    While DayOfWeek( DT2 ) <> 0 Do
      Inc(DT2.Day);

    If DT.Day < DT2.Day Then
      DLS := FALSE
    Else

    If DT.Day > DT2.Day Then
      DLS := TRUE

    Else
    BEGIN

      {------------------}
      { Compare 2am time }
      {------------------}

      If DT.Hour < ChangeHour Then
        DLS := FALSE
      Else
        DLS := TRUE;

    END;

  END
  Else

  If (DT.Month = FallMonth) Then
  BEGIN

    {------------------}
    { Find last Sunday }
    {------------------}

    DT2     := DT;
    DT2.Day := DaysInMonth(FallMonth, DT.Year);

    While DayOfWeek( DT2 ) <> 0 Do
      Dec(DT2.Day);

    If DT.Day < DT2.Day Then
      DLS := FALSE
    Else

    If DT.Day > DT2.Day Then
      DLS := TRUE
    Else
    BEGIN

      {------------------}
      { Compare 2am time }
      {------------------}

      If DT.Hour < ChangeHour Then
        DLS := FALSE
      Else
        DLS := TRUE;

    END;

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;

[PARAMETERS]

Swatch      Source Time

[RETURNS]

Whether the source time is Post Meridian [PM]

[DESCRIPTION]

Returns whether the source time is AM or PM.  If it is PM the function
reports TRUE, else AM=FALSE.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  IsTimePM(               Swatch         : TSwatch   ) : BOOLEAN;

BEGIN

  IsTimePM := ( Swatch >= ( cdtSecsInDay DIV 2) );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  CompleteYear(           Year           : WORD      ) : WORD;

[PARAMETERS]

Year        The partial year (ie. 93, but can be 1993 for completeness)

[RETURNS]

The completed year (ie. 1993)

[DESCRIPTION]

This figures out an incomplete given year.  This uses cdtYearBase as the
demarker between centuries.

[SEE-ALSO]

[EXAMPLE]

  W := CompleteYear( 93 );

  { W = 1993 }

  W := CompleteYear( 3 );

  { W = 2003 }

-*)

Function  CompleteYear(           Year           : WORD      ) : WORD;

BEGIN

  If (Year < 1900) Then
    Year := Year + 1900;

  If (Year < cdtYearBase) Then
    Year := Year + 100;

  CompleteYear := Year;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
                                  MaskStr        : STRING    ) : STRING;

[PARAMETERS]

DTEx        Date and time set with extensions.
MaskStr     String to put date and time set "over".

[RETURNS]

Formatted string.

[DESCRIPTION]

Converts a date and time set into a string using a specified template.

Some of the command entries are:

  'Y' = Year.
  'M' = Month.
  'D' = Day.
  'H' = Hour.
  'I' = Minute.
  'S' = Second.
  'W' = Day of Week.
  '1' = 100th Second.
  '#' = Use a value formatting of next entry.
  '$' = Use a string formatting of next entry.
  '+' = Complete the previous entry.

NOTES:

  ■ Years default to the 2-character representation of that year.  For
    example, '93' for the year 1993.  If the whole '1993' needs to be
    shown, use string formatting as '$YYYY' or '$Y+'.

  ■ Days, if toggled with string formatting, will add an ordinal suffix
    to the output.  For example: on day 12, '$D+' would return '12th'.

[SEE-ALSO]

[EXAMPLE]

Var

  DTEx : TDateTimeEx;
  S    : STRING;

BEGIN

  DTEx.Year   := 1993;
  DTEx.Month  := 11;
  DTEx.Day    := 1;
  DTEx.Hour   := 12;
  DTEx.Min    := 34;
  DTEx.Sec    := 56;
  DTEx.Sec100 := 561;

  S := VDatesMaskStr( DTEx, '$M+' );

  { S = 'November' }

  S := VDatesMaskStr( DTEx, 'W+ M+/D+/Y+ H+:I+:S+.1+' );

  { S = 'Monday 11/1/1993 12:34:56.0' }

  S := VDatesMaskStr( DTEx, 'WW DD/MM/YY' );

  { S = 'Mo 1/11/93' }

-*)

Function  VDatesMaskStr(          DTEx           : TDateTimeEx;
                                  MaskStr        : STRING    ) : STRING;

Const

  MaxMode = 11;

Type

  TModeRec = RECORD

    Mask     : CHAR;
    Index    : BYTE;
    S        : STRING[20];    { MaxCount = Length(S) }

  END;

  TModes = Array[1..MaxMode] of TModeRec;

Var

  DT   : TDateTime;
  Mode : TModes;
  Last : BYTE;
  Times: INTEGER;
  S    : STRING;

  L1   : BYTE;
  L2   : BYTE;
  L3   : BYTE;

BEGIN

  {-------------------------}
  { Initialize lookup table }
  {-------------------------}

  For L1 := 1 to MaxMode Do
    Mode[L1].Index := 1;

  Mode[1].Mask  := 'Y'; { Year                 }
  Mode[2].Mask  := 'M'; { Month                }
  Mode[3].Mask  := 'D'; { Day                  }
  Mode[4].Mask  := 'H'; { Hours                }
  Mode[5].Mask  := 'I'; { Minutes              }
  Mode[6].Mask  := 'S'; { Seconds              }
  Mode[7].Mask  := 'W'; { DayOfWeek            }
  Mode[8].Mask  := '1'; { Seconds (100th)      }
  Mode[9].Mask  := '#'; { Value of next entry  }
  Mode[10].Mask := '$'; { String of next entry }
  Mode[11].Mask := '+'; { Complete last entry  }

  {---------------------------}
  { Default entry definations }
  {---------------------------}

  Mode[1].S := IntToStr(DTEx.Year);
  Mode[1].S := CopyStr( Mode[1].S,
                        LesserInt( Byte(Mode[1].S[0]), 3 ),
                        LesserInt( Byte(Mode[1].S[0]), 2 ) );
  Mode[2].S := IntToStr(DTEx.Month);
  Mode[3].S := IntToStr(DTEx.Day);
  Mode[4].S := Pad( IntToStr(DTEx.Hour), 2, OnLeft, '0' );
  Mode[5].S := Pad( IntToStr(DTEx.Min),  2, OnLeft, '0' );
  Mode[6].S := Pad( IntToStr(DTEx.Sec),  2, OnLeft, '0' );

  ExToDateTime( DTEx, DT );
  Mode[7].S := cdtDayStr[DayOfWeek(DT)]; { !! Assumes to calc DOW; not given }

  Mode[8].S := IntToStr(DTEx.Sec100);
  Mode[9].S  := ' ';
  Mode[10].S := ' ';
  Mode[11].S := ' ';

  S    := '';
  Last := 0;

  {---------------------------}
  { Now scan through mask and }
  { create output string from }
  {---------------------------}

  For L1 := 1 to Byte(MaskStr[0]) Do
  BEGIN

    {-----------------------------------}
    { Look for mask character in lookup }
    {-----------------------------------}

    L2 := 1;

    While (L2 <= MaxMode) AND
          (MaskStr[L1] <> Mode[L2].Mask) Do
      Inc(L2);

    If L2 > MaxMode Then
      S := S + MaskStr[L1]
    Else

    If Mode[L2].Index <= Byte(Mode[L2].S[0]) Then
    BEGIN

      Times := 1;

      Case L2 of

         9 :

          BEGIN

            If Succ(L1) <= Byte(MaskStr[0]) Then
            BEGIN

              Inc(L1);

              L2 := 1;

              While (L2 <= MaxMode) AND
                    (MaskStr[L1] <> Mode[L2].Mask) Do
                Inc(L2);

              If L2 <= MaxMode Then
              BEGIN

                If NOT ValidLong( Mode[L2].S ) Then
                BEGIN

                  Case L2 Of

                    1 : Mode[1].S := CopyStr(IntToStr(DTEx.Year), 3, 2);
                    2 : Mode[2].S := IntToStr(DTEx.Month);
                    3 : Mode[3].S := IntToStr(DTEx.Day);
                    4 : Mode[4].S := Pad(IntToStr(DTEx.Hour),2,OnLeft,'0');
                    5 : Mode[5].S := Pad(IntToStr(DTEx.Min),2,OnLeft,'0');
                    6 : Mode[6].S := Pad(IntToStr(DTEx.Sec),2,OnLeft,'0');
                    7 :
                      BEGIN
                        ExToDateTime(DTEx, DT);
                        Mode[7].S := IntToStr(DayOfWeek(DT)); { !! }
                      END;

                    8 : Mode[8].S := IntToStr(DTEx.Sec100);

                  End;

                END;

              END;

            END;

          END;

        10 :

          BEGIN

            If Succ(L1) <= Byte(MaskStr[0]) Then
            BEGIN

              Inc(L1);

              L2 := 1;

              While (L2 <= MaxMode) AND
                    (MaskStr[L1] <> Mode[L2].Mask) Do
                Inc(L2);

              If L2 <= MaxMode Then
              BEGIN

                If ValidLong( Mode[L2].S ) Then
                BEGIN

                  Case L2 Of

                    1 : Mode[1].S := IntToStr(DTEx.Year);
                    2 : Mode[2].S := cdtMonthStr[DTEx.Month];
{ !^!                   3 : Mode[3].S := IntToStr(DTEx.Day) + OrdSuffix(DTEx.Day);}
                    4 : Mode[4].S := IntToText(DTEx.Hour);
                    5 : Mode[5].S := IntToText(DTEx.Min);
                    6 : Mode[6].S := IntToText(DTEx.Sec);
                    7 :
                      BEGIN
                        ExToDateTime(DTEx, DT);
                        Mode[7].S := cdtDayStr[DayOfWeek(DT)]; { !! }
                      END;

                    8 : Mode[8].S := IntToText(DTEx.Sec100);

                  End;

                END;

              END;

            END;

          END;

        11 :

          BEGIN

            L2    := Last;
            Times := Byte(Mode[L2].S[0]) - Mode[L2].Index + 1;

          END;

      End;

      For L3 := 1 to Times Do
      BEGIN

        S := S + Mode[L2].S[ Mode[L2].Index ];
        Inc(Mode[L2].Index);

      END;

      Last := L2;

    END;

  END;

  VDatesMaskStr := S;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  ValidDate(              Year           : WORD;
                                  Month          : WORD;
                                  Day            : WORD      ) : BOOLEAN;

[PARAMETERS]

Day         Source Day
Mon         Source Month
Year        Source Year

[RETURNS]

Condition of values.

[DESCRIPTION]

Checks if all values are within their proper range.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  ValidDate(              Year           : WORD;
                                  Month          : WORD;
                                  Day            : WORD      ) : BOOLEAN;

BEGIN

  ValidDate := (Day >= 1) AND
               (Day <= DaysInMonth(Month, Year)) AND
               (Month >= 1) AND
               (Month <= 12) AND
               (Year >= cdtYearBase);

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  ValidTime(              Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD      ) : BOOLEAN;

[PARAMETERS]

Hour        Source Hours
Min         Source Minutes
Sec         Source Seconds

[RETURNS]

Condition of values.

[DESCRIPTION]

Checks if all values are within their proper range.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  ValidTime(              Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD      ) : BOOLEAN;

BEGIN

  ValidTime := (Hour < 24) AND
               (Min  < 60) AND
               (Sec  < 60);

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;

[PARAMETERS]

DT          Source DateTime

[RETURNS]

Condition of values.

[DESCRIPTION]

Checks if all values are within their proper range.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  ValidDateTime(          DT             : TDateTime ) : BOOLEAN;

BEGIN

  ValidDateTime := ValidTime( DT.Hour, DT.Min, DT.Sec ) AND
                   ValidDate( DT.Day, DT.Month, DT.Year );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;

[PARAMETERS]

PackedDT    Source Packed DateTime

[RETURNS]

Condition of values.

[DESCRIPTION]

Checks if all values are within their proper range.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  ValidPacked(            PackedDT       : TPackedDT ) : BOOLEAN;

Var

  DT : TDateTime;

BEGIN

  UnpackTime(PackedDT, DT);
  ValidPacked := ValidDateTime(DT);

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;

[PARAMETERS]

Swatch      Source StopWatch

[RETURNS]

Condition of values.

[DESCRIPTION]

Checks if all values are within their proper range.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  ValidSwatch(            Swatch         : TSwatch   ) : BOOLEAN;

BEGIN

  ValidSwatch := ( Swatch >= 0 ) AND
                 ( Round(Swatch) < cdtSecsInDay );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure CurrDateTime(       Var DT             : TDateTime );

[PARAMETERS]

DT          Variable to put clock date/time into

[RETURNS]

(VAR     : DOS date/time )

[DESCRIPTION]

Returns the current date and time set in the operating system

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure CurrDateTime(       Var DT             : TDateTime );

Var

  Temp : WORD;

BEGIN

  GetDate( DT.Year, DT.Month, DT.Day, Temp );
  GetTime( DT.Hour, DT.Min,   DT.Sec, Temp );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DateTimeStr(            DT             : TDateTime ) : STRING;

[PARAMETERS]

DT          Date/Time to convert

[RETURNS]

Converted string

[DESCRIPTION]

Converts Date/Time into string following the template as defined in
the variable constant cdpDateTimeMask.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DateTimeStr(            DT             : TDateTime ) : STRING;

Var

  DTEx : TDateTimeEx;

BEGIN

  DateTimeToEx( DT, DTEx );
  DateTimeStr := VDatesMaskStr( DTEx, cdtDateTimeMask );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DateTimeMaskStr(        DT             : TDateTime;
                                  Mask           : STRING    ) : STRING;

[PARAMETERS]

DT          Date/Time to convert

[RETURNS]

Converted string

[DESCRIPTION]

Converts Date/Time into string following the template of Mask.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DateTimeMaskStr(        DT             : TDateTime;
                                  Mask           : STRING    ) : STRING;
Var

  DTEx : TDateTimeEx;

BEGIN

  DateTimeToEx( DT, DTEx );
  DateTimeMaskStr := VDatesMaskStr( DTEx, Mask );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure IncDateTime(        Var DT             : TDateTime );

[PARAMETERS]

DT          Date/Time to increment

[RETURNS]

DT          Incremented Date/Time

[DESCRIPTION]

Increments a Date/Time record by one second.  Adjusts components accordingly.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure IncDateTime(        Var DT             : TDateTime );

Var
  DTemp : TDateTime;

BEGIN

  DTemp := DT;

  Inc( DT.Sec );

  While (DT.Sec > 59) Do
  BEGIN

    Dec( DT.Sec, 60 );
    Inc( DT.Min );

  END;  { While DT.Sec }

  While (DT.Min > 59) Do
  BEGIN

    Dec( DT.Min, 60 );
    Inc( DT.Hour );

  END;  { While DT.Min }

  While (DT.Hour > 23) Do
  BEGIN

    Dec( DT.Hour, 24 );
    Inc( DT.Day );

  END;  { While DT.Hour }

  While (DT.Day > DaysInMonth( DT.Month MOD 12+1, DT.Year ) ) Do
  BEGIN

    Dec( DT.Day, DaysInMonth( DT.Month MOD 12+1, DT.Year ) );
    Inc( DT.Month );

  END;  { While DT.Day }

  While (DT.Month > 12) Do
  BEGIN

    Dec( DT.Month, 12 );
    Inc( DT.Year );

  END;  { While DT.Month }

  If NOT ValidDateTime( DT ) Then
    DT := DTemp;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure DecDateTime(        Var DT             : TDateTime );

[PARAMETERS]

DT          Date/Time to decrement

[RETURNS]

DT          Decremented Date/Time

[DESCRIPTION]

Decrements a Date/Time record by one second.  Adjusts components accordingly.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure DecDateTime(        Var DT             : TDateTime );

Var

  DTemp : TDateTime;

BEGIN

  DTemp := DT;

  Dec( DT.Sec, 1 );

  While (DT.Sec < 0) Do
  BEGIN

    Inc( DT.Sec, 60 );
    Dec( DT.Min );

  END;

  While (DT.Min < 0) Do
  BEGIN

    Inc( DT.Min, 60 );
    Dec( DT.Hour );

  END;

  While (DT.Hour < 0) Do
  BEGIN

    Inc( DT.Hour, 24 );
    Dec( DT.Day );

  END;

  While (DT.Day < 1) Do
  BEGIN

    Inc( DT.Day, DaysInMonth( (DT.Month-1) MOD 12 + 1, DT.Year ) );
    Dec( DT.Month );

  END;

  While (DT.Month < 1) Do
  BEGIN

    Inc( DT.Month, 12 );
    Dec( DT.Year );

  END;

  If NOT ValidDateTime( DT ) Then
    DT := DTemp;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure AddDateTime(            DTAdd          : TDateTime;
                              Var DT             : TDateTime );

[PARAMETERS]

DTAdd       Date/Time to add

[RETURNS]

DT          Base TDateTime with additions

[DESCRIPTION]

Adds specified DateTime components to a given TDateTime.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure AddDateTime(            DTAdd          : TDateTime;
                              Var DT             : TDateTime );

VAR

  DTemp      : TDateTime;
  Hr,Min,Sec : INTEGER;
  Day,Mon,Yr : INTEGER;

BEGIN

  DTemp := DT;

  Hr  := DT.Hour;
  Min := DT.Min;
  Sec := DT.Sec;
  Day := DT.Day;
  Mon := DT.Month;
  Yr  := DT.Year;

  Inc( Hr,  DTAdd.Hour );
  Inc( Min, DTAdd.Min );
  Inc( Sec, DTAdd.Sec );
  Inc( Day, DTAdd.Day );
  Inc( Mon, DTAdd.Month );
  Inc( Yr,  DTAdd.Year );

  While (Sec > 59) Do
  BEGIN

    Dec( Sec, 60 );
    Inc( Min );

  END;  { If Sec }

  While (Min > 59) Do
  BEGIN

    Dec( Min, 60 );
    Inc( Hr );

  END;  { If Min }

  While (Hr > 23) Do
  BEGIN

    Dec( Hr, 24 );
    Inc( Day );

  END;  { If Hr }

  While (Mon > 12) Do
  BEGIN

    Dec( Mon, 12 );
    Inc( Yr );

  END;  { If Mon }

  While (Day > DaysInMonth( Mon, Yr ) ) Do
  BEGIN

    Dec( Day, DaysInMonth( Mon, Yr ) );
    Inc( Mon );

    If (Mon > 12) Then
    BEGIN

      Dec( Mon, 12 );
      Inc( Yr );

    END;  { If Mon }

  END;  { If Day }

  DT.Hour  := Hr;
  DT.Min   := Min;
  DT.Sec   := Sec;
  DT.Day   := Day;
  DT.Month := Mon;
  DT.Year  := Yr;

  If NOT ValidDateTime( DT ) Then
    DT := DTemp;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure SubDateTime(            DTSub          : TDateTime;
                              Var DT             : TDateTime );

[PARAMETERS]

DTSub       Date/Time to subtract

[RETURNS]

DT          Base TDateTime with subtractions.

[DESCRIPTION]

Subtracts specified DateTime components to a given TDateTime.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure SubDateTime(            DTSub          : TDateTime;
                              Var DT             : TDateTime );

Var

  Hr,Min,Sec : INTEGER;
  Day,Mon,Yr : INTEGER;

BEGIN

  Hr  := DT.Hour;
  Min := DT.Min;
  Sec := DT.Sec;
  Day := DT.Day;
  Mon := DT.Month;
  Yr  := DT.Year;

  Dec( Hr,  DTSub.Hour );
  Dec( Min, DTSub.Min );
  Dec( Sec, DTSub.Sec );
  Dec( Day, DTSub.Day );
  Dec( Mon, DTSub.Month );
  Dec( Yr,  DTSub.Year );

  While (Sec < 0) Do
  BEGIN

    Inc( Sec, 60 );
    Dec( Min );

  END;  { While Sec }

  While (Min < 0) Do
  BEGIN

    Inc( Min, 60 );
    Dec( Hr );

  END;  { While Min }

  While (Hr < 0) Do
  BEGIN

    Inc( Hr, 24 );
    Dec( Day );

  END;  { While Hr }

  While (Mon < 1) Do
  BEGIN

    Inc( Mon, 12 );
    Dec( Yr );

  END;  { While Mon }

  While (Day < 1) Do
  BEGIN

    If Mon = 1 Then
      Inc( Day, DaysInMonth( (Mon-2) MOD 12 + 13, Yr-1 ) )

    Else
      Inc( Day, DaysInMonth( (Mon-2) MOD 12 + 1, Yr ) );

    Dec( Mon );

    If (Mon < 1) Then
    BEGIN

      Inc( Mon, 12 );
      Dec( Yr );

    END;  { If Mon }

  END;  { While Day }

  DT.Hour  := Hr;
  DT.Min   := Min;
  DT.Sec   := Sec;
  DT.Day   := Day;
  DT.Month := Mon;
  DT.Year  := Yr;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure DateTimeDiff(           DT1            : TDateTime;
                                  DT2            : TDateTime;
                              Var DTDiff         : TDateTime );

[PARAMETERS]

DT1         Date/Time #1
DT2         Date/Time #2

[RETURNS]

DTDiff      Date/Time differences

[DESCRIPTION]

Calculates the absolute difference (distance between) the two given
TDateTime types.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure DateTimeDiff(           DT1            : TDateTime;
                                  DT2            : TDateTime;
                              Var DTDiff         : TDateTime );

Var

  P1  : TPackedDT;
  P2  : TPackedDT;

BEGIN

  PackTime( DT1, P1 );
  PackTime( DT2, P2 );

  If P1 > P2 Then
  BEGIN

    DTDiff := DT1;
    SubDateTime( DT2, DTDiff );

  END
  Else
  BEGIN

    DTDiff := DT2;
    SubDateTime( DT1, DTDiff );

  END;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure ExToDateTime(           DTEx           : TDateTimeEx;
                              Var DT             : TDateTime   );

[PARAMETERS]

DTEx        DateTime with extensions

[RETURNS]

DT          DateTime without extensions

[DESCRIPTION]

Removes the DOW and Sec100 from a TDateTimeEx type and puts the
rest into a TDateTime type.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure ExToDateTime(           DTEx           : TDateTimeEx;
                              Var DT             : TDateTime   );

BEGIN

  DT.Year  := DTEx.Year;
  DT.Month := DTEx.Month;
  DT.Day   := DTEx.Day;
  DT.Hour  := DTEx.Hour;
  DT.Min   := DTEx.Min;
  DT.Sec   := DTEx.Sec;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure DateTimeToEx(           DT             : TDateTime;
                              Var DTEx           : TDateTimeEx );

[PARAMETERS]

DT          DateTime without Extensions

[RETURNS]

DTEx        DateTime with Extensions (initialized)

[DESCRIPTION]

Creates a TDateTimeEx type from a given TDateTime type.  This only
initializes the extensions.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure DateTimeToEx(           DT             : TDateTime;
                              Var DTEx           : TDateTimeEx );

BEGIN

  DTEx.Year  := DT.Year;
  DTEx.Month := DT.Month;
  DTEx.Day   := DT.Day;
  DTEx.Hour  := DT.Hour;
  DTEx.Min   := DT.Min;
  DTEx.Sec   := DT.Sec;
  DTEx.DOW   := 0;
  DTEx.Sec100:= 0;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DTtoJulian(             DT             : TDateTime ) : TJulian;

[PARAMETERS]

DT          Day/Month/Year to convert

[RETURNS]

Julian date

[DESCRIPTION]

Converts a Gregorian calendar Day, Month, and Year into a Julian calendar
date (linear date system).

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DTtoJulian(             DT             : TDateTime ) : TJulian;

Var

  AY : INTEGER;
  Y  : WORD;
  M  : BYTE;
  D  : TJulian;
  G  : TJulian;

BEGIN

  AY := DT.Year;

  If AY < 0 Then
    Y := AY + 4717
  Else
    Y := AY + 4716;

  If DT.Month < 3 Then
  BEGIN

    M  := LongInt(DT.Month) + 12;
    Dec(Y);
    Dec(AY);

  END
  Else
    M := LongInt(DT.Month);

  D := ( 1461 * LongInt(Y)) SHR 2 + (153 * (Succ(M)) DIV 5) +
         LongInt(DT.Day) - 1524;

  G := D + 2 - AY DIV 100 + AY DIV 400 - AY DIV 4000;

  If G >= 2299161 Then
    DTtoJulian := G
  Else
    DTtoJulian := D;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure JulianToDT(             J              : TJulian;
                              Var DT             : TDateTime );

[PARAMETERS]

J           Julian date

[RETURNS]

DT          TDateTime with Day/Month/Year filled

[DESCRIPTION]

Converts a Julian calendar date (linear date system) into its Gregorian
Day, Month, and Year equivalent.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure JulianToDT(             J              : TJulian;
                              Var DT             : TDateTime );


Var

  AA,
  AB,
  A   : TJulian;
  B,
  D,
  EE  : LONGINT;
  C   : WORD;
  E   : BYTE;
  Y   : INTEGER;

BEGIN

  If J < 2299161 Then
    A := LongInt(J)
  Else
  BEGIN

    AA := J - 1721120;
    AB := 31 * (AA DIV 1460969);
    AA := AA MOD 1460969;
    AB := AB + 3 * (AA DIV 146097);
    AA := AA MOD 146097;

    If AA = 146096 Then
      AB := AB + 3
    Else
      AB := AB + AA DIV 36524;

    A := J + (AB - 2)

  END;

  B  := A + 1524;
  C  := (20 * B - 2442) DIV 7305;
  D  := 1461 * LongInt(C) SHR 2;
  EE := B - D;
  E  := 10000 * EE DIV 306001;
  DT.Day := Word(EE - 306001 * E DIV 10000);

  If E >= 14 Then
    DT.Month := Word(E - 13)
  Else
    DT.Month := Word(Pred(E));

  If DT.Month > 2 Then
    Y := C - 4716
  Else
    Y := C - 4715;

  If Y < 1 Then
    DT.Year := Word(Pred(Y))
  Else
    DT.Year := Word(Y);

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;

[PARAMETERS]

DT          Date/Time (date part is ignored)

[RETURNS]

Swatch with hours, minutes, and seconds.

[DESCRIPTION]

Converts a TDateTime type into a swatch.  Note that the date portion is
ignored.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DTtoSwatch(             DT             : TDateTime ) : TSwatch;

BEGIN

  DTtoSwatch := HMS1toSwatch( DT.Hour, DT.Min, DT.Sec, 0 );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure SwatchToDT(             Swatch         : TSwatch;
                              Var DT             : TDateTime );

[PARAMETERS]

Swatch      TSwatch source

[RETURNS]

TDateTime type with hour, min, and sec filled.

[DESCRIPTION]

Converts a TSwatch type into a TDateTime with hour, min, and sec filled.
Note that the date portion of the TDateTime is ignored.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure SwatchToDT(             Swatch         : TSwatch;
                              Var DT             : TDateTime );

Var

  Sec100 : WORD;

BEGIN

  SwatchToHMS1( Swatch, DT.Hour, DT.Min, DT.Sec, Sec100 );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;

[PARAMETERS]

DT          TDateTime source

[RETURNS]

Unix time code (base 1970)

[DESCRIPTION]

This converts a TDateTime into seconds from January 1st, 1970 (12:00 AM
Greenwich time).

[SEE-ALSO]

[EXAMPLE]

-*)

Function  DTtoUnix(               DT             : TDateTime ) : TUnixDT;

BEGIN

  { do time zone stuff later }

  DTToUnix := ( (DTtoJulian(DT) - cdtUnixBase) * cdtSecsInDay) +
                Round(DTtoSwatch(DT) );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure UnixToDT(               UnixDT         : TUnixDT;
                              Var DT             : TDateTime );

[PARAMETERS]

UnixDT      Unix time code (base 1970)

[RETURNS]

TDateTime destination

[DESCRIPTION]

Converts a Unix time code (seconds from base January 1st, 1970  12:00 AM
Greenwich time) into a DateTime type.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure UnixToDT(               UnixDT         : TUnixDT;
                              Var DT             : TDateTime );

BEGIN

  JulianToDT( (UnixDT DIV cdtSecsInDay) + cdtUnixBase, DT );
  SwatchToDT( (UnixDT MOD cdtSecsInDay), DT );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  CurrPackedDT                                         : TPackedDT;

[PARAMETERS]

[RETURNS]

Packed Date/Time

[DESCRIPTION]

Returns the current date and time set in a 4-byte bitfield record.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  CurrPackedDT                                         : TPackedDT;

Var

  DT : TDateTime;
  PDT: TPackedDT;

BEGIN

  CurrDateTime( DT );
  PackTime( DT, PDT );
  CurrPackedDT := PDT;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;

[PARAMETERS]

PackedDT    Packed TDateTime

[RETURNS]

Date as a WORD

[DESCRIPTION]

Returns date portion of a packed TDateTime.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  GetPackedDate(          PackedDT       : TPackedDT ) : WORD;

BEGIN

  GetPackedDate := PackedDT SHR $10;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;

[PARAMETERS]

PackedDT    Packed TDateTime

[RETURNS]

Time as a WORD

[DESCRIPTION]

Returns time portion of a packed TDateTime.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  GetPackedTime(          PackedDT       : TPackedDT ) : WORD;

BEGIN

  GetPackedTime := PackedDT AND $FFFF;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  CurrSwatch                                           : TSwatch;

[PARAMETERS]

[RETURNS]

Swatch time.

[DESCRIPTION]

Returns the current time set of the operating system in seconds.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  CurrSwatch                                           : TSwatch;

Var

  DTEx : TDateTimeEx;

BEGIN

  GetTime( DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  CurrSwatch := ( DTEx.Hour * 3600 ) +
                ( DTEx.Min * 60 ) +
                ( DTEx.Sec ) +
                ( DTEx.Sec100 / 100 );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  HMS1ToSwatch(           Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD;
                                  Sec100         : WORD      ) : TSwatch;

[PARAMETERS]

Hour        Source hour
Min         Source minute
Sec         Source second

[RETURNS]

Swatch time.

[DESCRIPTION]

Converts the given Hour/Min/Sec into a TSwatch type.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  HMS1ToSwatch(           Hour           : WORD;
                                  Min            : WORD;
                                  Sec            : WORD;
                                  Sec100         : WORD      ) : TSwatch;

BEGIN

  HMS1ToSwatch := ( Hour * 3600 ) +
                  ( Min  * 60 ) +
                  ( Sec ) +
                  ( Sec100 div 100 );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure SwatchToHMS1(           Swatch         : TSwatch;
                              Var Hour           : WORD;
                              Var Min            : WORD;
                              Var Sec            : WORD;
                              Var Sec100         : WORD      );

[PARAMETERS]

Swatch      Given TSwatch type

[RETURNS]

Hour        Hour of Swatch
Min         Minute of Swatch
Sec         Second of Swatch
Sec100      100th second of Swatch

[DESCRIPTION]

Converts a TSwatch type into its Hour/Min/Sec/Sec100 components.


[SEE-ALSO]

[EXAMPLE]

-*)

Procedure SwatchToHMS1(           Swatch         : TSwatch;
                              Var Hour           : WORD;
                              Var Min            : WORD;
                              Var Sec            : WORD;
                              Var Sec100         : WORD      );

BEGIN

  Hour   := Round(Swatch) DIV 3600;
  Min    := (Round(Swatch) MOD 3600 ) DIV 60;
  Sec    := Round(Swatch) MOD 60;
  Sec100 := Round(Frac(Swatch) * 100);

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;

[PARAMETERS]

Swatch      Given TSwatch type

[RETURNS]

Swatch as a string.

[DESCRIPTION]

Converts a TSwatch type into a string using 'cdtSwatchMask' for string
formatting.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  SwatchStr(              Swatch         : TSwatch   ) : STRING;

Var

  DTEx : TDateTimeEx;

BEGIN

  SwatchToHMS1( Swatch, DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  SwatchStr := VDatesMaskStr( DTEx, cdtSwatchMask );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  SwatchMaskStr(          Swatch         : TSwatch;
                                  Mask           : STRING    ) : STRING;

[PARAMETERS]

Swatch      Given TSwatch type

[RETURNS]

Swatch as a string.

[DESCRIPTION]

Converts a TSwatch type into a string using user-supplied mask for string
formatting.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  SwatchMaskStr(          Swatch         : TSwatch;
                                  Mask           : STRING    ) : STRING;

Var

  DTEx : TDateTimeEx;

BEGIN

  SwatchToHMS1( Swatch, DTEx.Hour, DTEx.Min, DTEx.Sec, DTEx.Sec100 );
  SwatchMaskStr := VDatesMaskStr( DTEx, Mask );

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  AddSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

[PARAMETERS]

Swatch      TSwatch used as base time
Hours       Hours to add
Mins        Minutes to add
Secs        Seconds to add
Sec100s     100th seconds to add

[RETURNS]

TSwatch type

[DESCRIPTION]

Adds hours, minutes, seconds, and 100th seconds to a Swatch.  It will loop
around at every midnight;

[SEE-ALSO]

[EXAMPLE]

-*)

Function  AddSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

Var

  Swatch2 : TSwatch;

BEGIN

  Swatch2 := Swatch + HMS1toSwatch( Hours, Mins, Secs, Sec100s );

  While (Swatch2 > cdtSecsInDay) Do
    Swatch2 := Swatch2 - cdtSecsInDay;

  AddSwatch := Swatch2;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  SubSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

[PARAMETERS]

Swatch      TSwatch used as base time
Hours       Hours to subtract
Mins        Minutes to subtract
Secs        Seconds to subtract
Sec100s     100th seconds to subtract

[RETURNS]

TSwatch type

[DESCRIPTION]

Subtracts hours, minutes, seconds, and 100th seconds to a Swatch.  It
will loop around at every midnight.

[SEE-ALSO]

[EXAMPLE]

-*)

Function  SubSwatch(              Swatch         : TSwatch;
                                  Hours          : WORD;
                                  Mins           : WORD;
                                  Secs           : WORD;
                                  Sec100s        : WORD      ) : TSwatch;

Var

  Swatch2 : TSwatch;

BEGIN

  Swatch2 := HMS1toSwatch( Hours, Mins, Secs, Sec100s );

  While (Swatch2 > cdtSecsInDay) Do
    Swatch2 := Swatch2 - cdtSecsInDay;

  Swatch2 := Swatch - Swatch2;

  If Swatch2 < 0 Then
    SubSwatch := Swatch2 + cdtSecsInDay
  Else
    SubSwatch := Swatch2;

END;

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Procedure SwatchDiff(             Swatch1        : TSwatch;
                                  Swatch2        : TSwatch;
                              Var Hours          : WORD;
                              Var Mins           : WORD;
                              Var Secs           : WORD;
                              Var Sec100s        : WORD      );

[PARAMETERS]

Swatch1     TSwatch #1
Swatch2     TSwatch #2

[RETURNS]

Hours       Hour(s) difference
Mins        Min(s) difference
Secs        Second(s) difference
Sec100s     100th second(s) difference

[DESCRIPTION]

Returns the absolute difference (distance) between the two given Swatches.

[SEE-ALSO]

[EXAMPLE]

-*)

Procedure SwatchDiff(             Swatch1        : TSwatch;
                                  Swatch2        : TSwatch;
                              Var Hours          : WORD;
                              Var Mins           : WORD;
                              Var Secs           : WORD;
                              Var Sec100s        : WORD      );

Var

  Swatch3 : TSwatch;

BEGIN

  Swatch3 := Abs( Swatch1 - Swatch2 );
  SwatchToHMS1( Swatch3, Hours, Mins, Secs, Sec100s );

END;


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function  SwatchExpired(          Swatch1        : TSwatch;
                                  Expire100s     : LONGINT   ) : BOOLEAN


[PARAMETERS]

Swatch1     TSwatch #1
Expire100s  Number of 100s after which the swatch will expire

[RETURNS]

TRUE        if "Expire100s" have passed since "Swatch1" or
FALSE       if "Expire100s" have NOT passed since "swatch1".


[DESCRIPTION]

Determines if a given "expire100s" count of 100/ths of a second have
passed since a given "swatch1" was "set".

[SEE-ALSO]

[EXAMPLE]

  SaveSwatch := CurrSwatch;

  If Not SwatchExpired( SaveSwatch, 200 ) Then
    Write( '.');

  { will write '.' until 2 seconds have passed. }


-*)


Function  SwatchExpired(          Swatch1        : TSwatch;
                                  Expire100s     : LONGINT   ) : BOOLEAN;

Var

  TheCurrSwatch : TSwatch;
  YesterdayDiff : REAL;

BEGIN

  TheCurrSwatch := CurrSwatch;

  {-----------------------------}
  { did we roll past midnight?? }
  {-----------------------------}

  If TheCurrSwatch>=Swatch1 Then
  BEGIN

    {------------------------------------------------------}
    { Nope. Check to see if "expire100s" have passed since }
    { the swatch1 time.                                    }
    {------------------------------------------------------}

    SwatchExpired := ( TheCurrSwatch >= (Swatch1+(Expire100s/100)) )

  END
  ELSE
  BEGIN

    {------------------------------------------------------}
    { Yep.  Calculate the # of 100s that passed yesterday, }
    { and check to see if "expire100s" is greater than     }
    { the 100s from yesterday + the 100s so far today.     }
    {------------------------------------------------------}

    YesterdayDiff := cdt100sinDay - Swatch1;

    SwatchExpired := ( (YesterdayDiff+TheCurrSwatch) >= (Expire100s/100) );

  END; { if (not past midnight) / else }

END; { function swatchexpired }

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;

[PARAMETERS]

Days        VAR Returned ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function GetTicksSinceMidnt(  Var Days           : BYTE      ) : LONGINT;

{$IFNDEF OS2}

Assembler;
ASM

  LES  DI, [Days]

  MOV  AH, $00
  INT  $1A

  JC   @@1                   {Carry Flag = Error}

  MOV  byte PTR ES:SI, AL    {No Error = Store Function Results}
  MOV  AX, DX
  MOV  DX, CX
  JMP  @@2

 @@1:
  MOV  byte PTR ES:SI, 0     {Error = Zero Out Function Result}
  XOR  AX, AX
  XOR  DX, DX

 @@2:

END;  { GetTicksSinceMidnt }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;

[PARAMETERS]

Ticks       ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetTicksSinceMidnt(      Ticks          : LONGINT   ) : BOOLEAN;

{$IFNDEF OS2}

Assembler;
ASM

  MOV  CX, word PTR [Ticks+2]
  MOV  DX, word PTR [Ticks  ]

  MOV  AH, $01
  INT  $1A

  MOV  AL, 1                 { Default = No Error }
  JNC   @NoErr

  XOR  AL, AL                { Error = Carry Flag Set }

  @NoErr:

END;  { SetTicksSinceMidnt }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function GetSysTime(          Var BCDHours       : BYTE;
                              Var BCDMins        : BYTE;
                              Var BCDSecs        : BYTE;
                              Var DSTActive      : BOOLEAN   ) : BOOLEAN;

[PARAMETERS]

BCDHours    VAR Returned ?
BCDMins     VAR Returned ?
BCDSecs     VAR Returned ?
DSTActive   VAR Returned ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function GetSysTime(          Var BCDHours       : BYTE;
                              Var BCDMins        : BYTE;
                              Var BCDSecs        : BYTE;
                              Var DSTActive      : BOOLEAN   ) : BOOLEAN;

{$IFNDEF OS2}

Assembler;
ASM

  PUSH DS

  MOV  AH, $02
  INT  $1A

  JNC @@1   { no err }

  {THIS IS TEST CODE}

    LDS SI, [BCDHours]
    MOV byte PTR [DS:SI], CH
    MOV byte PTR [DS:SI+1], CL
    MOV byte PTR [DS:SI+2], DH
    MOV byte PTR [DS:SI+3], DL

  {END OF TEST CODE}

  LES DI, [BCDHours]
  LDS SI, [BCDMins ]

  MOV byte PTR ES:DI, CH     { BCD Hours }
  MOV byte PTR DS:SI, CL     { BCD Minutes }

  LES DI, [BCDSecs  ]
  LDS SI, [DSTActive]

  MOV byte PTR ES:DI, DH     { BCD Seconds }
  MOV byte PTR DS:SI, DL     { Day Light Savings }

  JMP @@2

 @@1:
  LES DI, [BCDHours]
  LDS SI, [BCDMins ]

  MOV byte PTR ES:DI, 0      { BCD Hours }
  MOV byte PTR DS:SI, 0      { BCD Minutes }

  LES DI, [BCDSecs  ]
  LDS SI, [DSTActive]

  MOV byte PTR ES:DI, 0      { BCD Seconds }
  MOV byte PTR DS:SI, 0      { Day Light Savings }

 @@2:

END;  { GetSysTime }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetSysTime(              BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE;
                                  DSTActive      : BOOLEAN   ) : BOOLEAN;

[PARAMETERS]

BCDHours    ?
BCDMins     ?
BCDSecs     ?
DSTActive   ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetSysTime(              BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE;
                                  DSTActive      : BOOLEAN   ) : BOOLEAN;

{$IFNDEF OS2}

Assembler;
ASM

  MOV  CH, BCDHours
  MOV  CL, BCDMins
  MOV  DH, BCDSecs
  MOV  DL, DSTActive

  MOV  AH, $03
  INT  $1A

  MOV  AL, 1                 { Default = No Error }
  JNC  @@1

  XOR  AL, AL                { Error = CFlag }

 @@1:

END;  { SetSysTime }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function GetSysDate(          Var BCDDay         : BYTE;
                              Var BCDMon         : BYTE;
                              Var BCDYear        : BYTE;
                              Var BCDCent        : BYTE      ) : BOOLEAN;

[PARAMETERS]

BCDDay      VAR Returned ?
BCDMon      VAR Returned ?
BCDYear     VAR Returned ?
BCDCent     VAR Returned ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function GetSysDate(          Var BCDDay         : BYTE;
                              Var BCDMon         : BYTE;
                              Var BCDYear        : BYTE;
                              Var BCDCent        : BYTE      ) : BOOLEAN;
{$IFNDEF OS2}

Assembler;
ASM

  PUSH DS

  MOV  AH, $04
  INT  $1A

  JNC @@1   { no err }

  LES DI, [BCDDay ]
  LDS SI, [BCDMon ]
  MOV byte PTR ES:DI, DL     { BCD Day   }
  MOV byte PTR DS:SI, DH     { BCD Month }

  LES DI, [BCDYear]
  LDS SI, [BCDCent]
  MOV byte PTR ES:DI, CL     { BCD Year    }
  MOV byte PTR DS:SI, CH     { Day Century }

  JMP @@2

 @@1:
  LES DI, [BCDDay ]
  LDS SI, [BCDMon ]
  MOV byte PTR ES:DI, 0      { BCD Day   }
  MOV byte PTR DS:SI, 0      { BCD Month }

  LES DI, [BCDYear]
  LDS SI, [BCDCent]
  MOV byte PTR ES:DI, 0      { BCD Year    }
  MOV byte PTR DS:SI, 0      { Day Century }

 @@2:

END;  { GetSysDate }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetSysDate(              BCDDay         : BYTE;
                                  BCDMon         : BYTE;
                                  BCDYear        : BYTE;
                                  BCDCent        : BYTE      ) : BOOLEAN;

[PARAMETERS]

BCDDay      ?
BCDMon      ?
BCDYear     ?
BCDCent     ?

[RETURNS]

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetSysDate(              BCDDay         : BYTE;
                                  BCDMon         : BYTE;
                                  BCDYear        : BYTE;
                                  BCDCent        : BYTE      ) : BOOLEAN;
{$IFNDEF OS2}

Assembler;
ASM

  MOV  DL, BCDDay
  MOV  DH, BCDMon
  MOV  CL, BCDYear
  MOV  CH, BCDCent

  MOV  AH, $05
  INT  $1A

  MOV  AL, 1                 { Default = No Error }
  JNC  @@1

  XOR  AL, AL                { Error = CFlag }

 @@1:

END;  { SetSysDate }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}


{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetSysAlarmOn(           BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE      ) : BOOLEAN;
[PARAMETERS]

BCDHours    Alarm Hours in BCD Format
BCDMins     Alarm Minutes in BCD Format
BCDSecs     Alarm Seconds in BCD Format

[RETURNS]

Whether the Alarm was set to the provided Time  (TRUE=Alarm Set)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetSysAlarmOn(           BCDHours       : BYTE;
                                  BCDMins        : BYTE;
                                  BCDSecs        : BYTE      ) : BOOLEAN;
{$IFNDEF OS2}

Assembler;
ASM

  MOV  CH, BCDHours
  MOV  CL, BCDMins
  MOV  DH, BCDSecs

  MOV  AH, $06
  INT  $1A

  MOV  AL, 1                 { Default = No Error }
  JNC  @@1

  XOR  AL, AL                { Error = CFlag, if Alarm PreSet or NoClock }

 @@1:

END;  { SetSysAlarmOn }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}

{────────────────────────────────────────────────────────────────────────────}

(*-

[FUNCTION]

Function SetSysAlarmOff                                        : BOOLEAN;

[PARAMETERS]

(None)

[RETURNS]

Whether the System Alarm is Off (TRUE=Off)

[DESCRIPTION]

[SEE-ALSO]

[EXAMPLE]

-*)

Function SetSysAlarmOff                                        : BOOLEAN;


{$IFNDEF OS2}

Assembler;
ASM

  MOV  AH, $07
  INT  $1A

  MOV  AL, 1                 { Default = No Error }
  JNC  @@1

  XOR  AL, AL                { Error = CFlag }

 @@1:

END;  { SetSysAlarmOff }

{$ELSE}

BEGIN

  Halt( 69 );  {!^!}

END;

{$ENDIF}

Procedure Sleep(                  Sleep100s      : LONGINT   );

Var

  Sw : TSwatch;

BEGIN

  Sw := CurrSwatch;

  While Not SwatchExpired( Sw, Sleep100s ) Do;

END;


{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}

BEGIN
END.


TPackedDT information:
======================

  1 LONGINT = 2 WORD
              (DATE) yyyyyyymmmmddddd =

                [(Year - 1980) * 512] + (Month * 32) + Day

              (TIME) hhhhhmmmmmmsssss =

                (Hour SHL 10) + (Min SHL 5) + (Sec DIV 2)