home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / vb_code1 / holidays / holiday.bas next >
BASIC Source File  |  1993-10-29  |  19KB  |  408 lines
  1. Function HOLIDAY (YR As Integer, HDAY As Integer) As Variant
  2.     If YR < 0 Or YR > 9999 Or HDAY < 1 Or HDAY > 10 Then  'CHECK FOR INVALID PARAMETERS
  3.         HOLIDAY = 0                                       'AND RETURN AN ERROR IF DETECTED
  4.         Exit Function
  5.     End If
  6.     Dim TEMP As Long
  7.     Select Case HDAY
  8.         Case Is = 1                                     'MARTIN LUTHER KING DAY
  9.             TEMP = DateSerial(YR, 1, 1)
  10.             For X = 1 To 7
  11.                 If Weekday(TEMP) = 2 Then               'LOOP UNTIL MONDAY IS FOUND
  12.                     HOLIDAY = DateSerial(YR, 1, X + 14) 'JUMP TO 3RD MONDAY
  13.                     Exit Function
  14.                 Else
  15.                     TEMP = TEMP + 1
  16.                 End If
  17.             Next X
  18.         Case Is = 2                                     'PRESIDENTS DAY
  19.             TEMP = DateSerial(YR, 2, 1)
  20.             For X = 1 To 7
  21.                 If Weekday(TEMP) = 2 Then               'LOOP UNTIL MONDAY IS FOUND
  22.                     HOLIDAY = DateSerial(YR, 2, X + 14) 'JUMP TO 3RD MONDAY
  23.                     Exit Function
  24.                 Else
  25.                     TEMP = TEMP + 1
  26.                 End If
  27.             Next X
  28.         Case Is = 3                                     'EASTER
  29.             TEMP = (YR Mod 19) + 1
  30.             Select Case TEMP
  31.                 Case Is = 1
  32.                     TEMP = DateSerial(YR, 4, 14)
  33.                     If Weekday(TEMP) = 1 Then
  34.                         TEMP = TEMP + 7
  35.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  36.                         Exit Function
  37.                     Else
  38.                         For X = 1 To 7
  39.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  40.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  41.                                 Exit Function
  42.                             Else
  43.                                 TEMP = TEMP + 1
  44.                             End If
  45.                         Next X
  46.                     End If
  47.                 Case Is = 2
  48.                     TEMP = DateSerial(YR, 4, 3)
  49.                     If Weekday(TEMP) = 1 Then
  50.                         TEMP = TEMP + 7
  51.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  52.                         Exit Function
  53.                     Else
  54.                         For X = 1 To 7
  55.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  56.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  57.                                 Exit Function
  58.                             Else
  59.                                 TEMP = TEMP + 1
  60.                             End If
  61.                         Next X
  62.                     End If
  63.                 Case Is = 3
  64.                     TEMP = DateSerial(YR, 3, 23)
  65.                     If Weekday(TEMP) = 1 Then
  66.                         TEMP = TEMP + 7
  67.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  68.                         Exit Function
  69.                     Else
  70.                         For X = 1 To 7
  71.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  72.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  73.                                 Exit Function
  74.                             Else
  75.                                 TEMP = TEMP + 1
  76.                             End If
  77.                         Next X
  78.                     End If
  79.                 Case Is = 4
  80.                     TEMP = DateSerial(YR, 4, 11)
  81.                     If Weekday(TEMP) = 1 Then
  82.                         TEMP = TEMP + 7
  83.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  84.                         Exit Function
  85.                     Else
  86.                         For X = 1 To 7
  87.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  88.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  89.                                 Exit Function
  90.                             Else
  91.                                 TEMP = TEMP + 1
  92.                             End If
  93.                         Next X
  94.                     End If
  95.                 Case Is = 5
  96.                     TEMP = DateSerial(YR, 3, 31)
  97.                     If Weekday(TEMP) = 1 Then
  98.                         TEMP = TEMP + 7
  99.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  100.                         Exit Function
  101.                     Else
  102.                         For X = 1 To 7
  103.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  104.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  105.                                 Exit Function
  106.                             Else
  107.                                 TEMP = TEMP + 1
  108.                             End If
  109.                         Next X
  110.                     End If
  111.                 Case Is = 6
  112.                     TEMP = DateSerial(YR, 4, 18)
  113.                     If Weekday(TEMP) = 1 Then
  114.                         TEMP = TEMP + 7
  115.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  116.                         Exit Function
  117.                     Else
  118.                         For X = 1 To 7
  119.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  120.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  121.                                 Exit Function
  122.                             Else
  123.                                 TEMP = TEMP + 1
  124.                             End If
  125.                         Next X
  126.                     End If
  127.                 Case Is = 7
  128.                     TEMP = DateSerial(YR, 4, 8)
  129.                     If Weekday(TEMP) = 1 Then
  130.                         TEMP = TEMP + 7
  131.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  132.                         Exit Function
  133.                     Else
  134.                         For X = 1 To 7
  135.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  136.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  137.                                 Exit Function
  138.                             Else
  139.                                 TEMP = TEMP + 1
  140.                             End If
  141.                         Next X
  142.                     End If
  143.                 Case Is = 8
  144.                     TEMP = DateSerial(YR, 3, 28)
  145.                     If Weekday(TEMP) = 1 Then
  146.                         TEMP = TEMP + 7
  147.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  148.                         Exit Function
  149.                     Else
  150.                         For X = 1 To 7
  151.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  152.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  153.                                 Exit Function
  154.                             Else
  155.                                 TEMP = TEMP + 1
  156.                             End If
  157.                         Next X
  158.                     End If
  159.                 Case Is = 9
  160.                     TEMP = DateSerial(YR, 4, 16)
  161.                     If Weekday(TEMP) = 1 Then
  162.                         TEMP = TEMP + 7
  163.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  164.                         Exit Function
  165.                     Else
  166.                         For X = 1 To 7
  167.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  168.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  169.                                 Exit Function
  170.                             Else
  171.                                 TEMP = TEMP + 1
  172.                             End If
  173.                         Next X
  174.                     End If
  175.                 Case Is = 10
  176.                     TEMP = DateSerial(YR, 4, 5)
  177.                     If Weekday(TEMP) = 1 Then
  178.                         TEMP = TEMP + 7
  179.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  180.                         Exit Function
  181.                     Else
  182.                         For X = 1 To 7
  183.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  184.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  185.                                 Exit Function
  186.                             Else
  187.                                 TEMP = TEMP + 1
  188.                             End If
  189.                         Next X
  190.                     End If
  191.                 Case Is = 11
  192.                     TEMP = DateSerial(YR, 3, 25)
  193.                     If Weekday(TEMP) = 1 Then
  194.                         TEMP = TEMP + 7
  195.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  196.                         Exit Function
  197.                     Else
  198.                         For X = 1 To 7
  199.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  200.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  201.                                 Exit Function
  202.                             Else
  203.                                 TEMP = TEMP + 1
  204.                             End If
  205.                         Next X
  206.                     End If
  207.                 Case Is = 12
  208.                     TEMP = DateSerial(YR, 4, 13)
  209.                     If Weekday(TEMP) = 1 Then
  210.                         TEMP = TEMP + 7
  211.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  212.                         Exit Function
  213.                     Else
  214.                         For X = 1 To 7
  215.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  216.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  217.                                 Exit Function
  218.                             Else
  219.                                 TEMP = TEMP + 1
  220.                             End If
  221.                         Next X
  222.                     End If
  223.                 Case Is = 13
  224.                     TEMP = DateSerial(YR, 4, 2)
  225.                     If Weekday(TEMP) = 1 Then
  226.                         TEMP = TEMP + 7
  227.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  228.                         Exit Function
  229.                     Else
  230.                         For X = 1 To 7
  231.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  232.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  233.                                 Exit Function
  234.                             Else
  235.                                 TEMP = TEMP + 1
  236.                             End If
  237.                         Next X
  238.                     End If
  239.                 Case Is = 14
  240.                     TEMP = DateSerial(YR, 3, 22)
  241.                     If Weekday(TEMP) = 1 Then
  242.                         TEMP = TEMP + 7
  243.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  244.                         Exit Function
  245.                     Else
  246.                         For X = 1 To 7
  247.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  248.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  249.                                 Exit Function
  250.                             Else
  251.                                 TEMP = TEMP + 1
  252.                             End If
  253.                         Next X
  254.                     End If
  255.                 Case Is = 15
  256.                     TEMP = DateSerial(YR, 4, 10)
  257.                     If Weekday(TEMP) = 1 Then
  258.                         TEMP = TEMP + 7
  259.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  260.                         Exit Function
  261.                     Else
  262.                         For X = 1 To 7
  263.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  264.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  265.                                 Exit Function
  266.                             Else
  267.                                 TEMP = TEMP + 1
  268.                             End If
  269.                         Next X
  270.                     End If
  271.                 Case Is = 16
  272.                     TEMP = DateSerial(YR, 3, 30)
  273.                     If Weekday(TEMP) = 1 Then
  274.                         TEMP = TEMP + 7
  275.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  276.                         Exit Function
  277.                     Else
  278.                         For X = 1 To 7
  279.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  280.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  281.                                 Exit Function
  282.                             Else
  283.                                 TEMP = TEMP + 1
  284.                             End If
  285.                         Next X
  286.                     End If
  287.                 Case Is = 17
  288.                     TEMP = DateSerial(YR, 4, 17)
  289.                     If Weekday(TEMP) = 1 Then
  290.                         TEMP = TEMP + 7
  291.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  292.                         Exit Function
  293.                     Else
  294.                         For X = 1 To 7
  295.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  296.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  297.                                 Exit Function
  298.                             Else
  299.                                 TEMP = TEMP + 1
  300.                             End If
  301.                         Next X
  302.                     End If
  303.                 Case Is = 18
  304.                     TEMP = DateSerial(YR, 4, 7)
  305.                     If Weekday(TEMP) = 1 Then
  306.                         TEMP = TEMP + 7
  307.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  308.                         Exit Function
  309.                     Else
  310.                         For X = 1 To 7
  311.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  312.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  313.                                 Exit Function
  314.                             Else
  315.                                 TEMP = TEMP + 1
  316.                             End If
  317.                         Next X
  318.                     End If
  319.                 Case Is = 19
  320.                     TEMP = DateSerial(YR, 3, 27)
  321.                     If Weekday(TEMP) = 1 Then
  322.                         TEMP = TEMP + 7
  323.                         HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  324.                         Exit Function
  325.                     Else
  326.                         For X = 1 To 7
  327.                             If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  328.                                 HOLIDAY = DateSerial(YR, Month(TEMP), Day(TEMP))
  329.                                 Exit Function
  330.                             Else
  331.                                 TEMP = TEMP + 1
  332.                             End If
  333.                         Next X
  334.                     End If
  335.             End Select
  336.         Case Is = 4                                     'MOTHERS DAY
  337.             TEMP = DateSerial(YR, 5, 1)
  338.             For X = 1 To 7
  339.                 If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  340.                     HOLIDAY = DateSerial(YR, 5, X + 7)  'JUMP TO 2RD SUNDAY
  341.                     Exit Function
  342.                 Else
  343.                     TEMP = TEMP + 1
  344.                 End If
  345.             Next X
  346.         Case Is = 5                                     'ARMERD FORCES DAY
  347.             TEMP = DateSerial(YR, 5, 1)
  348.             For X = 1 To 7
  349.                 If Weekday(TEMP) = 7 Then               'LOOP UNTIL SATURDAY IS FOUND
  350.                     HOLIDAY = DateSerial(YR, 5, X + 14) 'JUMP TO 3RD SATURDAY
  351.                     Exit Function
  352.                 Else
  353.                     TEMP = TEMP + 1
  354.                 End If
  355.             Next X
  356.         Case Is = 6                                     'MEMORIAL DAY
  357.             TEMP = DateSerial(YR, 5, 31)
  358.             For X = 1 To 7
  359.                 If Weekday(TEMP) = 2 Then               'LOOP UNTIL MONDAY IS FOUND
  360.                     HOLIDAY = DateSerial(YR, 5, TEMP)
  361.                     Exit Function
  362.                 Else
  363.                     TEMP = TEMP - 1                      'DECREMENT UNTIL LAST MONDAY IN MAY IS FOUND
  364.                 End If
  365.             Next X
  366.         Case Is = 7                                     'FATHERS DAY
  367.             TEMP = DateSerial(YR, 6, 1)
  368.             For X = 1 To 7
  369.                 If Weekday(TEMP) = 1 Then               'LOOP UNTIL SUNDAY IS FOUND
  370.                     HOLIDAY = DateSerial(YR, 6, X + 14) 'JUMP TO 3RD SUNDAY
  371.                     Exit Function
  372.                 Else
  373.                     TEMP = TEMP + 1
  374.                 End If
  375.             Next X
  376.         Case Is = 8                                     'LABOR DAY
  377.             TEMP = DateSerial(YR, 9, 1)
  378.             For X = 1 To 7
  379.                 If Weekday(TEMP) = 2 Then               'LOOP UNTIL MONDAY IS FOUND
  380.                     HOLIDAY = DateSerial(YR, 9, X)
  381.                     Exit Function
  382.                 Else
  383.                     TEMP = TEMP + 1
  384.                 End If
  385.             Next X
  386.         Case Is = 9                                     'COLUMBUS DAY
  387.             TEMP = DateSerial(YR, 10, 1)
  388.             For X = 1 To 7
  389.                 If Weekday(TEMP) = 2 Then               'LOOP UNTIL MONDAY IS FOUND
  390.                     HOLIDAY = DateSerial(YR, 10, X + 7) 'JUMP TO 2ND MONDAY
  391.                     Exit Function
  392.                 Else
  393.                     TEMP = TEMP + 1
  394.                 End If
  395.             Next X
  396.         Case Is = 10                                     'THANKSGIVING DAY
  397.             TEMP = DateSerial(YR, 11, 1)
  398.             For X = 1 To 7
  399.                 If Weekday(TEMP) = 5 Then               'LOOP UNTIL THURSDAY IS FOUND
  400.                     HOLIDAY = DateSerial(YR, 11, X + 21) 'JUMP TO 4TH THURSDAY
  401.                     Exit Function
  402.                 Else
  403.                     TEMP = TEMP + 1
  404.                 End If
  405.             Next X
  406.     End Select
  407. End Function
  408.