home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / io / io_22 / datedemo.inc < prev    next >
Encoding:
Text File  |  1987-05-24  |  5.4 KB  |  169 lines
  1. { File = DATEDEMO.INC -- Include file for IO21DEMO.PAS -- 10/9/86 }
  2.  
  3. procedure date_demo ;
  4.   { demonstrates the things you can do with dates }
  5.  
  6. const
  7.     null_jul : juldate = (yr:0 ; day:0) ;
  8.     blanks   : string[10] = '          ' ;
  9.  
  10. var
  11.     date1,
  12.     date2,
  13.     temp1,
  14.     temp2    : date ;
  15.     workjul  : juldate ;
  16.     juldtst  : juldatestring ;
  17.     dtst     : datestring ;
  18.     fds      : fulldatestring ;
  19.     diff     : string[7] ;
  20.     n        : integer ;
  21.     prevfld  : integer ;
  22.  
  23. { ==================== }
  24.  
  25. procedure display_diff ;
  26.   begin
  27.     if equal_date (date1,null_date)
  28.     or equal_date (date2,null_date) then
  29.         for n := 20 to 21 do
  30.             clrline (16,n)
  31.     else if equal_date(date1,date2) then
  32.       begin
  33.         write_str ('The dates are equal',16,20) ;
  34.         write ('':20) ;
  35.         clrline (16,21)
  36.       end
  37.     else
  38.       begin
  39.         write_date (date1,16,20) ;
  40.         if greater_date(date1,date2) = 1 then
  41.           begin
  42.             write (' is later than ') ;
  43.             temp1 := date2 ;
  44.             temp2 := date1
  45.           end
  46.         else
  47.           begin
  48.             write (' is earlier than ') ;
  49.             temp1 := date1 ;
  50.             temp2 := date2
  51.           end ;
  52.         dtst := mk_dt_st(date2) ;
  53.         write (dtst) ;
  54.         write ('':20) ;
  55.         write_str ('There are ',16,21) ;
  56.         str(date_diff(temp1,temp2):7:0,diff) ;
  57.         diff := purgech(diff,' ') ;
  58.         write (diff,' days (about ') ;
  59.         write (month_diff(temp1,temp2)) ;
  60.         write (' months) between the two dates.') ;
  61.         write ('':10)
  62.       end
  63.   end ;
  64.  
  65. { ==================== }
  66.  
  67. begin { proc date_demo }
  68.     clrscr ;
  69.     write_str('Enter two dates, press ESC to quit.',16,1) ;
  70.     write_str('DATE 1               DATE 2',32,3) ;
  71.     write_str('------               ------',32,4) ;
  72.     write_str('==>                  ==>',26,6) ;
  73.     write_str('Julian date:',17,10) ;
  74.     write_str('Next day:',20,12) ;
  75.     write_str('Previous day:',16,14) ;
  76.     write_str('Leap year?',19,16) ;
  77.     write_str('=============================================',16,18) ;
  78.     date1 := null_date ;
  79.     date2 := null_date ;
  80.     fld := 1 ;
  81.     repeat
  82.         case fld of
  83.          1: begin
  84.               prevfld := 1 ;
  85.               read_date (date1,30,6) ;
  86.               if (date1.yr > 0) and (date1.yr < 1563) then
  87.                 begin
  88.                   show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
  89.                   date1.mo := 0 ; date1.dy := 0 ; date1.yr := 0 ;
  90.                   write_date (date1,30,6) ;
  91.                   fld := 1
  92.                 end ;
  93.               if not (equal_date(date1,null_date)) then
  94.                 begin
  95.                   fds := build_full_date_str (date1) ;
  96.                   write_str (fds,16,8) ;
  97.                   greg_to_jul (date1,workjul) ;
  98.                   juldtst := mk_jul_dt_st (workjul) ;
  99.                   write_str (juldtst,32,10) ;
  100.                   temp1 := date1 ;
  101.                   next_day (temp1) ;
  102.                   write_date (temp1,30,12) ;
  103.                   temp1 := date1 ;
  104.                   prev_day (temp1) ;
  105.                   write_date (temp1,30,14) ;
  106.                   write_bool (leapyear(date1.yr),32,16) ;
  107.                 end
  108.               else
  109.                 begin
  110.                   gotoxy(16,8) ; write('':fdslen) ;
  111.                   for n := 8 to 16 do
  112.                       write_str (blanks,30,n)
  113.                 end ;
  114.               display_diff
  115.             end ; { 1 }
  116.          2: begin
  117.               prevfld := 2 ;
  118.               read_date (date2,51,6) ;
  119.               if (date2.yr > 0) and (date2.yr < 1563) then
  120.                 begin
  121.                   show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
  122.                   date2.mo := 0 ; date2.dy := 0 ; date2.yr := 0 ;
  123.                   write_date (date2,51,6) ;
  124.                   fld := 2
  125.                 end ;
  126.               if not (equal_date(date2,null_date)) then
  127.                 begin
  128.                   fds := build_full_date_str (date2) ;
  129.                   write_str (fds,47,8) ;
  130.                   greg_to_jul (date2,workjul) ;
  131.                   juldtst := mk_jul_dt_st (workjul) ;
  132.                   write_str (juldtst,53,10) ;
  133.                   temp1 := date2 ;
  134.                   next_day (temp1) ;
  135.                   write_date (temp1,51,12) ;
  136.                   temp1 := date2 ;
  137.                   prev_day (temp1) ;
  138.                   write_date (temp1,51,14) ;
  139.                   write_bool (leapyear(date2.yr),53,16) ;
  140.                 end
  141.               else
  142.                 begin
  143.                   gotoxy (47,8) ; write ('':fdslen) ;
  144.                   for n := 10 to 16 do
  145.                       write_str (blanks,51,n)
  146.                 end;
  147.               display_diff
  148.             end ; { 2 }
  149.          3: begin
  150.               prevfld := 3 ;
  151.               pause
  152.             end
  153.         end ; { case }
  154.         if fld < 1 then                           { can't go back from 1 }
  155.             fld := 1
  156.         else if (fld > 3) and (fld < maxint) then
  157.           begin
  158.             if prevfld = 3 then
  159.                 fld := 1                          { back to beginning from 3 }
  160.             else
  161.                 fld := 3                          { trap next_page }
  162.           end
  163.     until fld = maxint ;
  164.     fld := 1  { reset FLD for calling proc }
  165. end ; { proc date_demo }
  166.  
  167. { ------ EOF DATEDEMO.INC ------------------------------------ }
  168.  
  169.