home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / WEEKDAY.BAS < prev   
Encoding:
BASIC Source File  |  1990-10-04  |  4.6 KB  |  138 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : WEEKDAY.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : WEEK DAY SUBROUTINE - RETURNS THE DAY OF THE WEEK
  9. '
  10. '****************************************************************************
  11. '  This program and those associated with it were written for use with Quick-
  12. '  Windows Advanced (Version 1.5+).  Possesion of this program entitles you
  13. '  to certain priviliges.  They are:
  14. '
  15. '     1. You may compile, use, or modify this program in any way you choose
  16. '        provided you do not sell or give away the source code to this prog-
  17. '        ram or any of it's companions to anyone for any reason.  You may,
  18. '        however, sell the resulting executable program as you see fit.
  19. '
  20. '     2. You may modify, enhance or change these programs as you see fit. I
  21. '        as that you keep a copy of the original code and that you notify
  22. '        me of any improvements you make.  I like to think that the code is
  23. '        bug free and cannot be improved upon, but I'm sure someone will
  24. '        find a way to make it better.  If it's you, I'm looking forward to
  25. '        seeing your changes.  I can be reached at:
  26. '
  27. '              Tim Beck                      Tim Beck (C/O Debbie Beck)
  28. '              19419 Franz Road              8030 Fairchild Avenue
  29. '              Houston, Texas  77084         Canoga Park, California 91306
  30. '              (713) 639-3079                (818) 998-0588
  31. '
  32. '     3. This code has been tested and re-tested in a variety of applications
  33. '        and although I have not found any bugs, doesn't mean none exist. So,
  34. '        this program along with it's companions comes with NO WARRANTY,
  35. '        either expressed or implied.  I'm sorry if there are problems, but
  36. '        I can't be responsible for your work.  I've tried to provide a safe
  37. '        and efficient programming enviroment and I hope you find it helpful
  38. '        for you.  I do, however, need to cover my butt!
  39. '
  40. '  I have enjoyed creating this library of programs and have found them to be
  41. '  a great time saver.  I hope you agree.
  42. '
  43. '                                                            Tim Beck //
  44. '
  45. '****************************************************************************
  46.  
  47.    DECLARE FUNCTION Get.MDY% (Dte$)
  48.    DECLARE SUB WEEKDAY (Dte$, Day%, Ddy%, Day$, NDay$, Month$)
  49.  
  50.   '-------------------------------------------------------------------------
  51.   '   Returns some useful information about the date ...
  52.   '
  53.   '   Dte$  = Date in European Format (YYMMDD)
  54.   '   Day%  = Number of Day of Week (1=Sunday, 2=Monday, ...)
  55.   '   Ddy%  = Number of Days since 1-01-1980
  56.   '   Day$  = Literary Day (Monday, Tuesday, etc.)
  57.   '   NDay$ = Number of Day (1st, 2nd, 3rd, 4th, etc.)
  58.   '   Month$= Month of Year (January, February, March, ...)
  59.  
  60.    REM $INCLUDE: 'STDCOM.INC'
  61.   
  62.    TIMER OFF   'Enables Event Trapping
  63.  
  64. SUB WEEKDAY (Dte$, Day%, Ddy%, Day$, NDay$, Month$) STATIC
  65.  
  66.    Yr% = VAL(MID$(Dte$, 1, 2))
  67.    Mo% = VAL(MID$(Dte$, 3, 2))
  68.    Dy% = VAL(MID$(Dte$, 5, 2))
  69.    Dyr% = Yr% - 80
  70.    Lyr% = FIX(Dyr% / 4) + 1
  71.    IF Mo% > 2 AND (Yr% MOD 4 = 0) THEN
  72.       Lyr% = Lyr% - 1
  73.    END IF
  74.    Ddy% = Dyr% * 365
  75.    Ddy% = Ddy% + Lyr%
  76.    Ddy% = Ddy% + Get.MDY%(Dte$) + 1
  77.    Day% = (Ddy% MOD 7) + 1
  78.      
  79.    SELECT CASE Day%
  80.       CASE 1
  81.          Day$ = "Sunday"
  82.       CASE 2
  83.          Day$ = "Monday"
  84.       CASE 3
  85.          Day$ = "Tuesday"
  86.       CASE 4
  87.          Day$ = "Wednesday"
  88.       CASE 5
  89.          Day$ = "Thursday"
  90.       CASE 6
  91.          Day$ = "Friday"
  92.       CASE 7
  93.          Day$ = "Saturday"
  94.       CASE ELSE
  95.    END SELECT
  96.  
  97.    SELECT CASE Mo%
  98.       CASE 1
  99.          Month$ = "January"
  100.       CASE 2
  101.          Month$ = "February"
  102.       CASE 3
  103.          Month$ = "March"
  104.       CASE 4
  105.          Month$ = "April"
  106.       CASE 5
  107.          Month$ = "May"
  108.       CASE 6
  109.          Month$ = "June"
  110.       CASE 7
  111.          Month$ = "July"
  112.       CASE 8
  113.          Month$ = "August"
  114.       CASE 9
  115.          Month$ = "September"
  116.       CASE 10
  117.          Month$ = "October"
  118.       CASE 11
  119.          Month$ = "November"
  120.       CASE 12
  121.          Month$ = "December"
  122.       CASE ELSE
  123.    END SELECT
  124.  
  125.    SELECT CASE Dy%
  126.       CASE 1, 21, 31
  127.          NDay$ = MID$(STR$(Dy%), 2) + "st"
  128.       CASE 2, 22
  129.          NDay$ = MID$(STR$(Dy%), 2) + "nd"
  130.       CASE 3, 23
  131.          NDay$ = MID$(STR$(Dy%), 2) + "rd"
  132.       CASE ELSE
  133.          NDay$ = MID$(STR$(Dy%), 2) + "th"
  134.    END SELECT
  135.  
  136. END SUB
  137.  
  138.