home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / sk210f.zip / TESTDATE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-13  |  4KB  |  126 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. unit TestDate;
  6. {
  7.                         To test the ShDatPk unit
  8.  
  9.                   Copyright 1991 Madison & Associates
  10.                           All Rights Reserved
  11.  
  12.          This program source file and the associated executable
  13.          file may be  used and distributed  only in  accordance
  14.          with the  provisions  described  on  the title page of
  15.                   the accompanying documentation file
  16.                               SKYHAWK.DOC
  17. }
  18.  
  19. interface
  20.  
  21. uses
  22.   TpDos,
  23.   TpString,
  24.   ShDatPk;
  25.  
  26. procedure DateTest;
  27.  
  28. implementation
  29.  
  30. procedure DateTest;
  31.  
  32. var
  33.   G               : GregType;
  34.   T               : TimeType;
  35.   Year,
  36.   Month,
  37.   Day,
  38.   Weekday,
  39.   JulianDate      : array[1..3] of integer;
  40.   JulianDayNumber : array[1..2] of LongInt;
  41.   Greg            : array[1..3] of GregType;
  42.  
  43.   O               : text;
  44.  
  45. begin
  46.   if OpenStdDev(O, 1) then ;       {Write to StdOut}
  47.  
  48.   WriteLn(O); WriteLn(O);
  49.   WriteLn(O, Center('SHDATPK TESTS', 72)); WriteLn(O);
  50.  
  51.   JDN2Greg(Today, G);
  52.   WriteLn(O, 'Today is day number ',Today,', a ',DayStr[DoW(G)]);
  53.   WriteLn(O, 'Today''s date (TodayStr) is ',TodayStr('='));
  54.   WriteLn(O, 'Today''s date (JDN2Str) is ',JDN2Str(Today,'/'));
  55.   WriteLn(O, '   as an ANSI string (YYYYMMDD) ', Today2ANSI);
  56.   WriteLn(O);
  57.  
  58.   WriteLn(O, 'The time in seconds since midnight is ',Now);
  59.   WriteLn(O, '    the a.m./p.m. time is ',NowStr(':',false));
  60.   WriteLn(O, '    the undelimited time is ',NowStr('',false));
  61.   WriteLn(O);
  62.   WriteLn(O, '    the military time is ',NowStr('',true));
  63.   WriteLn(O, '    the 24-hour time is ',NowStr(':',true));
  64.  
  65.   SSM2Time(Now, T);
  66.   WriteLn(O, '    the 24-hour time (SSM2Time, Time2TimeStr) is ',
  67.                                                   Time2TimeStr(T,':',true));
  68.   Now2Time(T);
  69.   WriteLn(O, '    the 24-hour time (Now2Time, Time2TimeStr) is ',
  70.                                                   Time2TimeStr(T,':',true));
  71.   WriteLn(O, '    the 24-hour time (Time2SSM, SSM2TimeStr) is ',
  72.                                        SSM2TimeStr(Time2SSM(T), '.', true));
  73.  
  74.   Flush(O);
  75.   if not HandleIsConsole(1) then
  76.     exit;
  77.  
  78.   WriteLn(O);
  79.   WriteLn(O, 'The remainder of this testing program will allow you to');
  80.   WriteLn(O, '  experiment with dates of your own choosing, entered as');
  81.   WriteLn(O, '  year, month, day in response to the prompts. ');
  82.   WriteLn(O);
  83.   WriteLn(O, ^G'  Note that the YEAR does not default to the 20th century.');
  84.   WriteLn(O, 'Enter "0" for the year to break out of this test.');
  85.   WriteLn(O);
  86.   repeat
  87.  
  88.     Write(O, 'Year   » '); ReadLn(Greg[1].Year);
  89.  
  90.     if Greg[1].Year = 0 then begin
  91.       Flush(O);
  92.       exit;
  93.       end;
  94.  
  95.     Write(O, 'Month  » '); ReadLn(Greg[1].Month);
  96.     Write(O, 'Day    » '); ReadLn(Greg[1].Day); WriteLn(O);
  97.  
  98.     WriteLn(O, 'You entered:');
  99.     WriteLn(O, '     ',DayStr[DoW(Greg[1])],', ',MonthStr[Greg[1].Month],
  100.                     ' ',Greg[1].Day,', ',Greg[1].Year);
  101.     WriteLn(O);
  102.  
  103.     JulianDayNumber[1] := Greg2JDN(Greg[1]);
  104.     JDN2Greg(JulianDayNumber[1], Greg[2]);
  105.     JulianDate[1] := Greg2JDate(Greg[2]);
  106.     Greg[3].Year := Greg[1].Year;
  107.     JDate2Greg(JulianDate[1], Greg[3].Year, Greg[3]);
  108.     Weekday[1] := DoW(Greg[3]);
  109.  
  110.     with Greg[1] do
  111.       WriteLn(O, Month,'/',Day,'/',Year,' is day number ',
  112.               JulianDayNumber[1]);
  113.  
  114.     with Greg[2] do
  115.       WriteLn(O, Month,'/',Day,'/',Year,' is day ',
  116.               JulianDate[1],' of the year.');
  117.  
  118.     with Greg[3] do
  119.       WriteLn(O, MonthStr[Month],' ',Day,', ',Year,' is a ',DayStr[Weekday[1]]);
  120.  
  121.     WriteLn(O); WriteLn(O);
  122.  
  123.     until false;
  124.   end; {DateTest}
  125. end.
  126.