home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FASTDA.ZIP / FASTDATE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-16  |  3.0 KB  |  116 lines
  1. {   File: FastDate.PAS
  2.   Author: David N. Dubois
  3.     Date: 1988.04.16
  4.  
  5.   Unit FastDate demonstrates the !FAST! day counting function. }
  6.  
  7. unit FastDate;
  8.  
  9. interface
  10.  
  11.   uses
  12.     dos; { for current date function }
  13.  
  14.   type
  15.     DateType = record
  16.                  Year  : integer;
  17.                  Month : 1 .. 12;
  18.                  Day   : 1 .. 31;
  19.                end;
  20.  
  21.   function CountDays ( Date : DateType ) : longint;
  22.  
  23.   function DaysBetweenDates ( Date1 : DateType;
  24.                               Date2 : DateType ) : longint;
  25.  
  26.   procedure DateIs ( var Date     : DateType;
  27.                          NewYear  : integer;
  28.                          NewMonth : byte;
  29.                          NewDay   : byte     );
  30.  
  31.   procedure Today ( var Date : DateType );
  32.  
  33.   function DayOfWeek ( Date : DateType ) : byte; { 0 = Sunday }
  34.  
  35.   function DateToString ( Date : DateType ) : string;
  36.  
  37.   const
  38.     January   =  1;
  39.     February  =  2;
  40.     March     =  3;
  41.     April     =  4;
  42.     May       =  5;
  43.     June      =  6;
  44.     July      =  7;
  45.     August    =  8;
  46.     September =  9;
  47.     October   = 10;
  48.     November  = 11;
  49.     December  = 12;
  50.  
  51. implementation
  52.  
  53.   function CountDays ( Date : DateType ) : longint;
  54.   external;
  55.   {$L FastDate.OBJ }
  56.  
  57.   function DaysBetweenDates ( Date1 : DateType;
  58.                               Date2 : DateType ) : longint;
  59.   begin
  60.     DaysBetweenDates := CountDays ( Date2 ) - CountDays ( Date1 );
  61.   end;
  62.  
  63.   procedure DateIs ( var Date     : DateType;
  64.                          NewYear  : integer;
  65.                          NewMonth : byte;
  66.                          NewDay   : byte     );
  67.   begin
  68.     with Date do
  69.       begin
  70.         Year  := NewYear;
  71.         Month := NewMonth;
  72.         Day   := NewDay;
  73.       end;
  74.   end;
  75.  
  76.   procedure Today ( var Date : DateType );
  77.   var
  78.     Year  : word;
  79.     Month : word;
  80.     Day   : word;
  81.     DOW   : word;
  82.   begin
  83.     getdate ( Year, Month, Day, DOW );
  84.     DateIs ( Date, Year, Month, Day );
  85.   end;
  86.  
  87.   function DayOfWeek ( Date : DateType ) : byte;
  88.   begin
  89.     DayOfWeek := ( CountDays ( Date ) + 716573 ) mod 7;
  90.   end;
  91.  
  92.   function DateToString ( Date : DateType ) : string;
  93.   const
  94.     MonthName : array [ 1 .. 12 ] of string [ 9 ]
  95.               = ( 'January',   'February', 'March',    'April',
  96.                   'May',       'June',     'July',     'August',
  97.                   'September', 'October',  'November', 'December' );
  98.     DOWName   : array [ 0 .. 6 ] of string [ 9 ]
  99.               = ( 'Sunday',  'Monday',  'Tuesday', 'Wednesday',
  100.                   'Thursday', 'Friday', 'Saturday'             );
  101.   var
  102.     DayString  : string;
  103.     YearString : string;
  104.   begin
  105.     with Date do
  106.       begin
  107.         str ( Day,  DayString );
  108.         str ( Year, YearString );
  109.         DateToString :=          DOWName   [ DayOfWeek ( Date ) ]
  110.                         + ', ' + MonthName [ Month ]
  111.                         + ' '  + DayString
  112.                         + ', ' + YearString;
  113.       end;
  114.   end;
  115.  
  116. end.