home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / MILTIME.PRG < prev    next >
Encoding:
Text File  |  1991-08-16  |  7.3 KB  |  286 lines
  1. /*
  2.  * File......: MILTIME.PRG
  3.  * Author....: Alexander B. Spencer
  4.  * CIS ID....: 76276,1012
  5.  * Date......: $Date:   15 Aug 1991 23:04:02  $
  6.  * Revision..: $Revision:   1.2  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/miltime.prv  $
  8.  * 
  9.  * This is an original work by Alexander B. Spencer and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/miltime.prv  $
  16.  * 
  17.  *    Rev 1.2   15 Aug 1991 23:04:02   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.1   14 Jun 1991 19:52:22   GLENN
  21.  * Minor edit to file header
  22.  * 
  23.  *    Rev 1.0   14 Jun 1991 03:43:52   GLENN
  24.  * Initial revision.
  25.  *
  26.  */
  27.  
  28.  
  29.  
  30.  
  31.  
  32. #ifdef FT_TEST
  33.  
  34.   function main()
  35.  
  36.      cls
  37.      ? "am-pm"
  38.      ? ft_civ2mil(" 5:40 pm")
  39.      ? ft_civ2mil("05:40 pm")
  40.      ? ft_civ2mil(" 5:40 PM")
  41.      ? ft_civ2mil(" 5:40 am")
  42.      ? ft_civ2mil("05:40 am")
  43.      ? ft_civ2mil(" 5:40 AM")
  44.      ?
  45.      inkey(0)
  46.      cls
  47.      ? "noon-midnight"
  48.      ? ft_civ2mil("12:00 m")
  49.      ? ft_civ2mil("12:00 M")
  50.      ? ft_civ2mil("12:00 m")
  51.      ? ft_civ2mil("12:00 n")
  52.      ? ft_civ2mil("12:00 N")
  53.      ? ft_civ2mil("12:00 n")
  54.      ?
  55.      inkey(0)
  56.      cls
  57.      ? "errors in noon-midnight"
  58.      ? ft_civ2mil("12:01 n")
  59.      ? ft_civ2mil("22:00 n")
  60.      ? ft_civ2mil("12:01 m")
  61.      ? ft_civ2mil("22:00 n")
  62.      ?
  63.      ? "sys to mil"
  64.      ? time()
  65.      ? ft_sys2mil()
  66.   return nil
  67.  
  68. #endif
  69.  
  70.  
  71.  
  72. /*  $DOC$
  73.  *  $FUNCNAME$
  74.  *     FT_MIL2MIN()
  75.  *  $CATEGORY$
  76.  *     Date/Time
  77.  *  $ONELINER$
  78.  *     Convert time in military format to number of minute of day.
  79.  *  $SYNTAX$
  80.  *     FT_MIL2MIN( <cMILTIME> ) -> nMINUTE
  81.  *  $ARGUMENTS$
  82.  *     <cMILTIME>  character string of form hhmm, where 0<=hh<24.
  83.  *  $RETURNS$
  84.  *     <nMINOFDAY>  numeric value representing minute of day.
  85.  *  $DESCRIPTION$
  86.  *     Converts time in military format to number of minute of the day.
  87.  *  $EXAMPLES$
  88.  *     FT_MIL2MIN( "1729" ) -> 1049
  89.  *  $SEEALSO$
  90.  *     FT_MIN2MIL() FT_CIV2MIL() FT_MIL2CIV() FT_SYS2MIL()
  91.  *  $END$
  92.  */
  93.  
  94. function FT_MIL2MIN(cMILTIME)
  95.   return int(val(left(cMILTIME,2))*60 + val(right(cMILTIME,2)))
  96.  
  97.  
  98. /*  $DOC$
  99.  *  $FUNCNAME$
  100.  *     FT_MIN2MIL()
  101.  *  $CATEGORY$
  102.  *     Date/Time
  103.  *  $ONELINER$
  104.  *     Convert minute of day to military format time.
  105.  *  $SYNTAX$
  106.  *     FT_MIN2MIL( <nMINUTE> ) -> cMILTIME
  107.  *  $ARGUMENTS$
  108.  *     <nMINUTE>  numeric integer representing minute of day.
  109.  *  $RETURNS$
  110.  *     <cMILTIME>  character string of form hhmm, where 0<=hh<24.
  111.  *  $DESCRIPTION$
  112.  *     Converts minute of the day to military format time.
  113.  *  $EXAMPLES$
  114.  *     FT_MIN2MIL( 279 ) -> 0439
  115.  *  $SEEALSO$
  116.  *     FT_MIL2MIN() FT_MIL2CIV() FT_CIV2MIL() FT_SYS2MIL()
  117.  *  $END$
  118.  */
  119.  
  120. function FT_MIN2MIL(nMIN)
  121.   nMIN := nMIN%1440
  122.   return  right("00" + ltrim(str(INT(nMIN/60))),2) + ;
  123.           right("00" + ltrim(str(INT(nMIN%60))),2)
  124.  
  125.  
  126.  
  127. /*  $DOC$
  128.  *  $FUNCNAME$
  129.  *     FT_MIL2CIV()
  130.  *  $CATEGORY$
  131.  *     Date/Time
  132.  *  $ONELINER$
  133.  *     Convert time in military format to civilian format.
  134.  *  $SYNTAX$
  135.  *     FT_MIL2CIV( <cCIVTIME> ) -> dMILTIME
  136.  *  $ARGUMENTS$
  137.  *     <cMILTIME>  character string of form hhmm, where 0<=hh<24.
  138.  *  $RETURNS$
  139.  *     <cCIVTIME>  character string of form hh:mm (am,pm,n or m), 
  140.  *        where 0<hh<12.
  141.  *  $DESCRIPTION$
  142.  *     Converts time from military to civilian format
  143.  *  $EXAMPLES$
  144.  *     FT_MIL2CIV( "1640" ) ->  4:40 pm
  145.  *
  146.  *     FT_MIL2CIV( "0440" ) ->  4:40 am
  147.  *
  148.  *     FT_MIL2CIV( "1200" ) -> 12:00 n
  149.  *
  150.  *     FT_MIL2CIV( "0000" ) and FT_MIL2CIV( "2400" ) -> 12:00 m
  151.  *
  152.  *     Caution:  leading blanks are irrelevant.
  153.  *  $SEEALSO$
  154.  *     FT_CIV2MIL() FT_SYS2MIL() FT_MIL2MIN() FT_MIN2MIL()
  155.   *  $END$
  156.  */
  157.  
  158. function FT_MIL2CIV(cMILTIME)
  159.   local cHRS,cMINS,nHRS,cCIVTIME
  160.  
  161.   nHRS  := val(LEFT(cMILTIME,2))
  162.   cMINS := right(cMILTIME,2)
  163.  
  164.   do case
  165.      case (nHRS == 24 .OR. nHRS == 0) .AND. (cMINS == "00")  // Midnight
  166.         cCIVTIME = "12:00 m"
  167.      case (nHRS == 12)                                       // Noon to 12:59pm
  168.         if cMINS == "00"
  169.            cCIVTIME = "12:00 n"
  170.         else
  171.            cCIVTIME = "12:" + cMINS + " pm"
  172.         endif
  173.      case (nHRS < 12)                                    && AM
  174.         if nHRS == 0
  175.            cHRS = "12"
  176.         else
  177.            cHRS = right("  " + ltrim(str(int(nHRS))),2)
  178.         endif
  179.         cCIVTIME = cHRS + ":" + cMINS + " am"
  180.       
  181.   otherwise                                           && PM
  182.      cCIVTIME = right("  " + ltrim(str(int(nHRS - 12))), 2) + ;
  183.                 ":" + cMINS + " pm"
  184.   endcase
  185.  
  186.   return cCIVTIME
  187.  
  188.  
  189.  
  190. /*  $DOC$
  191.  *  $FUNCNAME$
  192.  *     FT_CIV2MIL()
  193.  *  $CATEGORY$
  194.  *     Date/Time
  195.  *  $ONELINER$
  196.  *     Convert usual civilian format time to military time.
  197.  *  $SYNTAX$
  198.  *     FT_CIV2MIL( <cCIVTIME> ) -> cMILTIME
  199.  *  $ARGUMENTS$
  200.  *     <cCIVTIME>  character string of form hh:mm (am,pm,n or m), 
  201.  *        where 0<hh<12.
  202.  *  $RETURNS$
  203.  *     <cMILTIME>  character string of form hhmm, where 0<=hh<24.
  204.  *  $DESCRIPTION$
  205.  *     Converts time from 12-hour civilian format to military.
  206.  *  $EXAMPLES$
  207.  *     FT_CIV2MIL( " 5:40 pm" ) -> 1740
  208.  *
  209.  *     FT_CIV2MIL( " 5:40 am" ) -> 0540
  210.  *
  211.  *     FT_CIV2MIL( "12:00 n" ) -> 1200
  212.  *
  213.  *     FT_CIV2MIL( "12:00 m" ) -> 0000
  214.  *     
  215.  *     Caution:  leading blanks are irrelevant; p,a,n,m must be preceded by
  216.  *               one and only one space.
  217.  *  $SEEALSO$
  218.  *     FT_MIL2CIV() FT_SYS2MIL() FT_MIL2MIN() FT_MIN2MIL()
  219.  *  $END$
  220.  */
  221.  
  222. function FT_CIV2MIL(cTIME)
  223.   local cKEY, cMILTIME
  224.  
  225. *** Insure leading 0's
  226. cTIME = REPLICATE("0", 3 - at(":", ltrim(cTIME))) + ltrim(cTIME)
  227.  
  228. *** Adjust for popular use of '12' for first hour after noon and midnight
  229. if left(ltrim(cTIME),2) == "12"
  230.    cTIME = stuff(cTIME, 1, 2, "00")
  231. endif
  232.  
  233. *** am, pm, noon or midnight
  234. cKEY = substr(ltrim(cTIME), 7, 1)
  235.  
  236. do case
  237. case upper(cKEY) == "N"                           && noon
  238.       if left(cTIME,2) + substr(cTIME,4,2) == "0000" 
  239.          cMILTIME = "1200"
  240.       else
  241.          cMILTIME = "    "
  242.       endif
  243.    case upper(cKEY) == "M"                           && midnight
  244.       if left(cTIME,2) + substr(cTIME,4,2) == "0000" 
  245.          cMILTIME = "0000"
  246.       else
  247.          cMILTIME = "    "
  248.       endif
  249.    case upper(cKEY) == "A"                           && am
  250.       cMILTIME = right("00" + ltrim(str(val(left(cTIME,2)))),2) + ;
  251.                  substr(cTIME,4,2)
  252.    case upper(cKEY) == "P"                           && pm
  253.       cMILTIME = right("00" + ltrim(str(val(left(cTIME,2))+12)),2) + ;
  254.                  substr(cTIME,4,2)
  255.    otherwise
  256.       cMILTIME = "    "                              && error
  257. endcase
  258.  
  259.   return cMILTIME
  260.  
  261.  
  262. /*  $DOC$
  263.  *  $FUNCNAME$
  264.  *     FT_SYS2MIL()
  265.  *  $CATEGORY$
  266.  *     Date/Time
  267.  *  $ONELINER$
  268.  *     Convert system time to military time format.
  269.  *  $SYNTAX$
  270.  *     FT_SYS2MIL() -> cMILTIME
  271.  *  $ARGUMENTS$
  272.  *     none
  273.  *  $RETURNS$
  274.  *     <cMILTIME>  character string of form hhmm, where 0<=hh<24.
  275.  *  $DESCRIPTION$
  276.  *     Return current system time as character string in military format.
  277.  *  $EXAMPLES$
  278.  *     FT_SYS2MIL() -> 1623
  279.  *  $SEEALSO$
  280.  *     FT_MIL2CIV() FT_CIV2MIL()
  281.  *  $END$
  282.  */
  283.  
  284. function FT_SYS2MIL()
  285. return left(stuff(time(),3,1,""),4)
  286.