Shareware Overload/ShartewareOverload.cdr/database/mailit.zip/MAILDATE.INC

Text File | 1986-03-12 | 8KB | 234 lines

{ MAILDATE.INC -- Date routines for Reliance Mailing List.
  WPM -- 2/21/86 }

{ COPYRIGHT (c) 1986, Wm Meacham, 1004 Elm Street, Austin, Tx  78703 }

type
    date = record
        yr : integer ; { 0 .. 9999 }
        mo : integer ; { 1 .. 12 }
        dy : integer ; { 1 .. 31 }
      end ;

    datestring = string[10] ;  { 'MM/DD/YYYY' }

const
    null_date     : date       = (yr:0 ; mo:0 ; dy:0) ;
    null_date_str : datestring = 'MM/DD/YYYY' ;


{ ------------------------------------------------------------ }

function mk_dt_st (dt : date) : datestring ;
  { Makes a string out of a date -- used for printing dates }
    var
        yr_st : string[4] ;
        mo_st : string[2] ;
        dy_st : string[2] ;
        dt_st : datestring ;
    begin
        with dt do
          begin
            if (yr=0) and (mo=0) and (dy=0) then
                dt_st := 'MM/DD/YYYY'
            else
              begin
                str (yr:4,yr_st) ;
                str (mo:2,mo_st) ;
                str (dy:2,dy_st) ;
                dt_st := concat (mo_st,'/',dy_st,'/',yr_st)
              end  { ELSE }
          end ;  { WITH DT DO }
        mk_dt_st := dt_st
    end ;  { --- PROC MK_DT_ST--- }

{ ------------------------------------------------------------ }

procedure write_date (dt: date ; col, row: integer) ;
  { Writes date at column and row specified }
    var
        ds : datestring ;
    begin
        ds := mk_dt_st (dt) ;
        write_str (ds,col,row)
    end ; { --- proc WRITE_DATE --- }

{ ------------------------------------------------------------ }

function leapyear (yr : integer) : boolean ;
{ Whether the year is a leap year or not.
  The year is year and century, e.g. year 1984 is '1984,' not '84' }
  begin
    leapyear := ((yr mod 4 = 0) and (not(yr mod 100 = 0)))
             or ( yr mod 400 = 0 )
  end ;

{ ------------------------------------------------------------ }

function valid_date (dt:date) : boolean ;
  { Test whether date is valid }
    var
        bad_fld : integer ;
    begin
        bad_fld := 0 ;
        with dt do
            begin
                if (mo = 0) and (dy = 0) and (yr = 0) then
                    bad_fld := 0
                else if not (mo in [1 .. 12]) then
                        bad_fld := 1
                else if (dy > 31)
                or (dy < 1)
                or ((mo in [4,6,9,11]) and (dy > 30)) then
                        bad_fld := 2
                else if mo = 2 then
                  begin
                    if (leapyear(yr) and (dy > 29))
                    or ((not leapyear(yr)) and (dy > 28)) then
                        bad_fld := 2
                  end
                else if yr = 0 then
                        bad_fld := 3
            end ; { with dt do }
        valid_date := (bad_fld = 0)
    end ; { function valid_date }

{ ------------------------------------------------------------ }

procedure read_date (var dt: date ; col, row: integer) ;

  { Read date at column and row specified.  If the user enters only
    two digits for the year, the procedure plugs the century as 1900 or
    2000, but the user can enter all four digits to override the plug. }

    var
        savefld, bad_fld : integer ;

    procedure edit_date ;                  { Edit for valid date }
        begin
            bad_fld := 0 ;
            with dt do
                begin
                    if (mo = 0) and (dy = 0) and (yr = 0) then
                        bad_fld := 0
                    else if not (mo in [1 .. 12]) then
                        begin
                            mo  := 0 ;
                            bad_fld := 1
                        end
                    else if (dy > 31)
                    or (dy < 1)
                    or ((mo in [4,6,9,11]) and (dy > 30)) then
                        begin
                            dy  := 0 ;
                            bad_fld := 2
                        end
                    else if mo = 2 then
                      begin
                        if (leapyear(yr) and (dy > 29))
                        or ((not leapyear(yr)) and (dy > 28)) then
                            begin
                                dy  := 0 ;
                                bad_fld := 2
                            end
                      end
                    else if yr = 0 then
                            bad_fld := 3
                end   { WITH DT DO }
        end ; { --- of EDIT_DATE --- }

    begin { READ_DATE }
        savefld := fld ;                    { Save FLD for rest of screen }
        fld := 1 ;                          { Set up FLD for use locally }
        write_date (dt, col, row) ;
        with dt do
            repeat
                repeat
                    case fld of
                        1 : read_int (mo, 2, col, row) ;
                        2 : read_int (dy, 2, col+3, row) ;
                        3 : begin
                              read_int (yr, 4, col+6, row) ;
                              if  (yr < 0) then
                                begin
                                  yr := 0 ;
                                  if (fld > 3) and (fld < maxint) then
                                      fld := 3
                                end
                              else if not((yr = 0) and (mo = 0) and (dy = 0)) then
                                begin
                                  if yr < 80 then         { Plug century }
                                      yr := 2000 + yr
                                  else if yr < 100 then
                                      yr := 1900 + yr
                                end ;
                              write_int (yr, 4, col+6, row)
                            end ; { 3 }
                    end ; { CASE }
                until (fld < 1) or (fld > 3) ;
                if (fld > 3) and (fld < maxint) then      { edit only }
                  begin                                   { going forward }
                    edit_date ;
                    if not (bad_fld = 0) then   { Date is bad }
                        begin
                            beep ;
                            fld := bad_fld
                        end
                  end
            until (fld < 1) or (fld > 3) ;
        write_date (dt,col,row) ;
        if fld = 0 then                     { Restore FLD for rest of screen }
                fld := savefld - 1
        else if fld = 4 then
                fld := savefld + 1

    end ; {--- of READ_DATE ---}

{ ------------------------------------------------------------ }

function equal_date (dt1, dt2 : date) : boolean ;
  { Tests whether two dates are equal }
    begin
        equal_date := (dt1.mo = dt2.mo) and (dt1.dy = dt2.dy)
                      and (dt1.yr = dt2.yr)
    end ;

{ ------------------------------------------------------------ }

function greater_date (dt1, dt2 : date) : integer ;
  { Compares two dates, returns 0 if both equal, 1 if first is
    greater, 2 if second is greater.  Converts both to strings,
    then compares the strings. }

    var
        stdt1, stdt2 : string[8] ;
        styr1, styr2 : string[4] ;
        stmo1, stmo2 : string[2] ;
        stdy1, stdy2 : string[2] ;

    begin
        with dt1 do
            begin
                str(yr:4,styr1) ;
                str(mo:2,stmo1) ;
                str(dy:2,stdy1) ;
                stdt1 := concat (styr1,stmo1,stdy1)
            end ;
        with dt2 do
            begin
                str(yr:4,styr2) ;
                str(mo:2,stmo2) ;
                str(dy:2,stdy2) ;
                stdt2 := concat (styr2,stmo2,stdy2)
            end ;
        if stdt1 > stdt2 then
                greater_date := 1
        else if stdt2 > stdt1 then
                greater_date := 2
        else { both equal }
                greater_date := 0
    end ; { --- of GREATER_DATE --- }

{ ---- EOF MAILDATE.INC -------------------------------------- }