home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library3 / figdat-u.bas < prev    next >
Encoding:
BASIC Source File  |  1990-09-29  |  5.5 KB  |  211 lines
  1.  
  2. '==============================================================================
  3. '                DATE ARITHMETIC MODULE -- FIGDAT-U.BAS
  4. '==============================================================================
  5. '                                                             -- 2-14-90
  6.  
  7.                                $COMPILE UNIT
  8.                                $ERROR ALL OFF
  9.  DEFINT A-Z
  10.  
  11.  EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
  12.  
  13.  
  14.  
  15.  FUNCTION GetDate$ PUBLIC
  16.  GetDate$ = Left$(DATE$,6)+RIGHT$(DATE$,2)
  17.      END FUNCTION
  18. '____________________________________________________________________________
  19.  
  20.  FUNCTION FigDate&(A$) PUBLIC
  21.  
  22.   LOCAL A#, M%, D%, Y&, LpYrDys%, W&, A&, B%
  23.  
  24. '  ON ERROR GOTO FigDateError
  25.   M% = VAL(LEFT$(A$,2))
  26.   D% = VAL(MID$(A$,4,2))
  27.   Y& = VAL(RIGHT$(A$,2))
  28. '  ON ERROR GOTO Oops
  29.  
  30. SELECT CASE M%
  31.     CASE <1, >12
  32.       GOTO FigDateError
  33.     CASE 1,3,5,7,8,10,12
  34.       IF D% < 1 OR D > 31% THEN FigDateError
  35.     CASE 4,6,9,11
  36.       IF D% < 1 OR D% > 30 THEN FigDateError
  37.     CASE 2
  38.       IF Y&/4 = FIX(Y&/4) AND Y& <> 0 THEN
  39.         IF D% < 1 OR D% > 29 THEN FigDateError
  40.       ELSE
  41.         IF D% < 1 OR D% > 28 THEN FigDateError
  42.            END IF: END SELECT
  43.  
  44.   IF Y& = 0 AND M% < 3 THEN GOTO DateRealOld
  45.   IF M% < 3 THEN DECR Y&
  46.  
  47.   A& = FIX(Y&/4): W& = 1461 * A&: A& = Y& - 4*A&
  48.   W& = W& + 365 * A&
  49.   SELECT CASE M%
  50.     CASE 3
  51.       B% = 0
  52.     CASE 4
  53.       B% = 31
  54.     CASE 5
  55.       B% = 61
  56.     CASE 6
  57.       B% = 92
  58.     CASE 7
  59.       B% = 122
  60.     CASE 8
  61.       B% = 153
  62.     CASE 9
  63.       B% = 184
  64.     CASE 10
  65.       B% = 214
  66.     CASE 11
  67.       B% = 245
  68.     CASE 12
  69.       B% = 275
  70.     CASE 1
  71.       B% = 306
  72.     CASE 2
  73.       B% = 337
  74.  END SELECT
  75.  
  76.  FigDate& = W& + B% + D% + 59: EXIT FUNCTION
  77.  
  78. DateRealOld:
  79.  IF M% = 2 THEN FigDate& = D%+31 ELSE FigDate& = D%
  80.  EXIT FUNCTION
  81.  
  82. FigDateError:
  83.  FigDate& = 0
  84. ' ON ERROR GOTO Oops
  85.  
  86.      END FUNCTION
  87. '____________________________________________________________________________
  88.  
  89.  FUNCTION WriteDate$ (Julioid&) PUBLIC
  90.  LOCAL W&, A#, B#, Y%, Y#, M$, D$, Y$
  91.  W& = Julioid&                    ' new line to avoid a new problem. see below.
  92.  IF W& > 36524 THEN WriteDate$ = " 2000 + ": EXIT FUNCTION
  93.  IF W& < 1 THEN WriteDate$ =  "ERR:FigD=0": EXIT FUNCTION
  94.  IF W& < 60 THEN
  95.   Y$ = "01"                       ' note: I had trouble with this guy after
  96.   SELECT CASE W&                  ' converting it from a DEF Fn to its present
  97.     CASE > 31                     ' form because -- it altered its argument!
  98.       M$ = "02": D$ = STR$(W&-31) ' (true FUNCTIONS do.)
  99.     CASE ELSE
  100.       M$ = "01": D$ = STR$(W&)
  101.          END SELECT
  102.  ELSE
  103.   W& = W& - 59
  104.   A# = INT (W&/1461)
  105.   W& = W& - 1461 * A#
  106.   B# = INT (W&/365.25)
  107.   Y# = 4 * A# + B#
  108.   W& = W& - B# * 365
  109.   SELECT CASE W&
  110.     CASE 0
  111.       M$ = "02": D$ = " 29"
  112.       EXIT SELECT
  113.     CASE 1 TO 31
  114.       M$ = "03": D$ = STR$(W&)
  115.       EXIT SELECT
  116.     CASE 32 TO 61
  117.       M$ = "04": D$ = STR$(W& - 31)
  118.       EXIT SELECT
  119.     CASE 62 TO 92
  120.       M$ = "05": D$ = STR$(W& - 61)
  121.       EXIT SELECT
  122.     CASE 93 TO 122
  123.       M$ = "06": D$ = STR$(W& - 92)
  124.       EXIT SELECT
  125.     CASE 123 TO 153
  126.       M$ = "07": D$ = STR$(W& - 122)
  127.       EXIT SELECT
  128.     CASE 154 TO 184
  129.       M$ = "08": D$ = STR$(W& - 153)
  130.       EXIT SELECT
  131.     CASE 185 TO 214
  132.       M$ = "09": D$ = STR$(W& - 184)
  133.       EXIT SELECT
  134.     CASE 215 TO 245
  135.       M$ = "10": D$ = STR$(W& - 214)
  136.       EXIT SELECT
  137.     CASE 246 TO 275
  138.       M$ = "11": D$ = STR$(W& - 245)
  139.       EXIT SELECT
  140.     CASE 276 TO 306
  141.       M$ = "12": D$ = STR$(W& - 275)
  142.       EXIT SELECT
  143.     CASE 307 TO 337
  144.       M$ = "01": D$ = STR$(W& - 306): INCR Y#
  145.       EXIT SELECT
  146.     CASE > 337
  147.       M$ = "02": D$ = STR$(W& - 337): INCR Y#
  148.         END SELECT
  149.  
  150.   END IF
  151.  
  152.   D$ = MID$(D$,2)
  153.   IF LEN(D$) = 1 THEN D$ = "0"+D$
  154.   Y% = Y#
  155.   Y$ = MID$(STR$(Y%),2)
  156.   IF LEN(Y$) = 1 THEN Y$ = "0"+Y$
  157.   WriteDate$ = M$+"-"+D$+"-"+Y$
  158.  END FUNCTION
  159. '____________________________________________________________________________
  160.  
  161.  FUNCTION WkDay$ (W&) PUBLIC
  162.     LOCAL N
  163.     N = W& MOD 7
  164.     SELECT CASE N
  165.       CASE 0
  166.         WkDay$ = "Sun":EXIT FUNCTION
  167.       CASE 1
  168.         WkDay$ = "Mon":EXIT FUNCTION
  169.       CASE 2
  170.         WkDay$ = "Tue":EXIT FUNCTION
  171.       CASE 3
  172.         WkDay$ = "Wed":EXIT FUNCTION
  173.       CASE 4
  174.         WkDay$ = "Thu":EXIT FUNCTION
  175.       CASE 5
  176.         WkDay$ = "Fri":EXIT FUNCTION
  177.       CASE 6
  178.         WkDay$ = "Sat": END SELECT: END FUNCTION
  179. '____________________________________________________________________________
  180.  
  181.  FUNCTION YearsSince (D0$) PUBLIC
  182.  LOCAL Y, D$
  183.  D$ = DATE$
  184.  Y = VAL (RIGHT$(D$,2)) - VAL (RIGHT$(D0$,2)) - 1
  185. '                                             (take deep breath ...)
  186.  IF VAL (LEFT$ (D$,2)) > VAL (LEFT$ (D0$,2)) THEN
  187.     INCR Y
  188.  ELSEIF VAL (LEFT$ (D$,2)) = VAL (LEFT$ (D0$,2))_
  189.               AND VAL (MID$(D$,4,2)) => VAL (MID$(D0$,4,2)) THEN
  190.     INCR Y
  191.  END IF
  192.  
  193.  YearsSince = Y
  194.                   END FUNCTION
  195.  
  196. '____________________________________________________________________________
  197.  
  198.  FUNCTION FlipDate$ (WrittenDate$) PUBLIC
  199.  FlipDate$ = RIGHT$(WrittenDate$,2)+LEFT$(WrittenDate$,2)_
  200.                                                     +MID$(WrittenDate$,4,2)
  201. END FUNCTION
  202.        '  this makes dates come out like 880312 (for today) for easy sorting
  203.  
  204.  
  205.  FUNCTION UnflipDate$ (FlippedDate$) PUBLIC
  206.    UnflipDate$ = MID$(FlippedDate$,3,2) + "-" + RIGHT$(FlippedDate$,2)_
  207.                                                  + "-" + LEFT$(FlippedDate$,2)
  208. END FUNCTION
  209.  
  210.  
  211.