home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / FUNCTION.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  6.7 KB  |  219 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : FUNCTION.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : FUNCTIONS
  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.    DECLARE FUNCTION Get.MDY% (dte$)
  47.    DECLARE FUNCTION Show$ (Show.String$, Show.Len%)
  48.    DECLARE FUNCTION FreeWind% ()
  49.    DECLARE FUNCTION FileName$ (filespec$)
  50.    DECLARE FUNCTION DriveName$ (filespec$)
  51.    DECLARE FUNCTION PathName$ (filespec$)
  52.    DECLARE FUNCTION Pad$ (Number%, Padby%, Padwith%)
  53.    DECLARE FUNCTION PadL$ (Number&, Padby%, Padwith%)
  54.    DECLARE FUNCTION PadS$ (Number$, Padby%, Padwith%)
  55.   
  56.    '-----------------------------------------------------------------------
  57.    '  Several Helpful Functions
  58.    '
  59.    '     GET.MDY!    returns the number of Days since the first of the Year
  60.    '     Show$       returns a string of a specified length (Elongating or Truncating as Necessary
  61.    '     FreeWind%   returns the next Free Window number
  62.    '     FileName$   returns the File Name of FileSpec$
  63.    '     DriveName$  returns the associated Drive of FileSpec$
  64.    '     PathName$   returns the associated path of FileSpec$
  65.    '     Pad$, PadL$ returns a number either padded with 0's or  's
  66.    '                 ie:      0003 (Padwith% = 0, Padby% = 4)
  67.    '                      or     3 (Padwith% = 1, Padby% = 4)
  68.    '     PadS$       is the same as PadL$ but with Strings
  69.  
  70.  
  71.    REM $INCLUDE: 'STDCOM.INC'
  72.   
  73.    TIMER OFF    'Enables Event Trapping
  74.  
  75. '   ON ERROR GOTO ErrorTrap
  76.  
  77. ErrorTrap:
  78.  
  79. '   RESUME
  80.  
  81. FUNCTION DriveName$ (filespec$) STATIC
  82.  
  83.    DString$ = RTRIM$(filespec$)
  84.    Colon% = INSTR(DString$, ":")
  85.   
  86.    IF Colon% > 0 THEN
  87.       IF MID$(DString$, Colon% + 1, 1) = "\" THEN
  88.          DString$ = LEFT$(DString$, Colon% + 1)
  89.       ELSE
  90.          DString$ = LEFT$(DString$, Colon%)
  91.       END IF
  92.    ELSE
  93.       DString$ = ""
  94.    END IF
  95.  
  96.    DriveName$ = DString$
  97.   
  98. END FUNCTION
  99.  
  100. FUNCTION FileName$ (filespec$) STATIC
  101.  
  102.    DString$ = filespec$
  103.   
  104.    IF LEN(DString$) = 0 THEN
  105.       EXIT FUNCTION
  106.    ELSEIF INSTR(DString$, "\") > 0 THEN
  107.       WHILE INSTR(DString$, "\")
  108.          DString$ = MID$(DString$, INSTR(DString$, "\") + 1)
  109.       WEND
  110.       FileName$ = DString$
  111.    ELSEIF INSTR(DString$, ":") > 0 THEN
  112.       DString$ = MID$(DString$, INSTR(DString$, ":") + 1)
  113.    ELSE
  114.       FileName$ = DString$
  115.    END IF
  116.  
  117. END FUNCTION
  118.  
  119. FUNCTION FreeWind%
  120.  
  121.    FreeWind% = 0
  122.    FOR w% = 1 TO 16
  123.       IF Free.Window%(w%) = 0 THEN
  124.          Free.Window%(w%) = -1
  125.          FreeWind% = w%
  126.          EXIT FOR
  127.       END IF
  128.    NEXT w%
  129.    IF w% = 16 THEN
  130.       BEEP
  131.       FreeWind% = 16
  132.    END IF
  133.  
  134. END FUNCTION
  135.  
  136. FUNCTION Get.MDY% (Ymddate$) STATIC
  137.  
  138.    Mo% = VAL(MID$(Ymddate$, 3, 2))
  139.    Dy% = VAL(MID$(Ymddate$, 5, 2))
  140.    Yr% = VAL(MID$(Ymddate$, 1, 2))
  141.  
  142.    IF Mo% = 1 THEN MDY% = 0
  143.    IF Mo% = 2 THEN MDY% = 31
  144.    IF Mo% = 3 THEN MDY% = 59
  145.    IF Mo% = 4 THEN MDY% = 90
  146.    IF Mo% = 5 THEN MDY% = 120
  147.    IF Mo% = 6 THEN MDY% = 151
  148.    IF Mo% = 7 THEN MDY% = 181
  149.    IF Mo% = 8 THEN MDY% = 212
  150.    IF Mo% = 9 THEN MDY% = 243
  151.    IF Mo% = 10 THEN MDY% = 273
  152.    IF Mo% = 11 THEN MDY% = 304
  153.    IF Mo% = 12 THEN MDY% = 334
  154.    IF Mo% > 2 AND Yr% MOD 4 = 0 THEN
  155.       MDY% = MDY% + 1
  156.    END IF
  157.  
  158.    MDY% = MDY% + Dy%
  159.  
  160.    Get.MDY% = MDY%
  161.  
  162. END FUNCTION
  163.  
  164. FUNCTION Pad$ (Number%, Padby%, Padwith%) STATIC
  165.  
  166.    IF Padwith% THEN
  167.       Pad$ = RIGHT$(SPACE$(Padby%) + MID$(STR$(Number%), 2), Padby%)
  168.    ELSE
  169.       Pad$ = MID$(STR$(Number% + (10 ^ Padby%)), 3, Padby%)
  170.    END IF
  171.  
  172. END FUNCTION
  173.  
  174. FUNCTION PadL$ (Number&, Padby%, Padwith%) STATIC
  175.  
  176.    IF Padwith% THEN
  177.       PadL$ = RIGHT$(SPACE$(Padby%) + MID$(STR$(Number&), 2), Padby%)
  178.    ELSE
  179.       PadL$ = MID$(STR$(Number& + (10 ^ Padby%)), 3, Padby%)
  180.    END IF
  181.  
  182. END FUNCTION
  183.  
  184. FUNCTION PadS$ (Number$, Padby%, Padwith%) STATIC
  185.  
  186.    Number# = VAL(Number$)
  187.  
  188.    IF Padwith% THEN
  189.       PadS$ = RIGHT$(SPACE$(Padby%) + MID$(STR$(Number#), 2), Padby%)
  190.    ELSE
  191.       PadS$ = MID$(STR$(Number# + (10 ^ Padby%)), 3, Padby%)
  192.    END IF
  193.  
  194. END FUNCTION
  195.  
  196. FUNCTION PathName$ (filespec$) STATIC
  197.  
  198.    DString$ = RTRIM$(filespec$)
  199.    PathName$ = ""
  200.  
  201.    IF LEN(DString$) > 0 THEN
  202.  
  203.       IF INSTR(DString$, FileName$(DString$)) > 1 THEN
  204.  
  205.          PathName$ = LEFT$(DString$, INSTR(DString$, FileName$(DString$)) - 1)
  206.  
  207.       END IF
  208.  
  209.    END IF
  210.  
  211. END FUNCTION
  212.  
  213. FUNCTION Show$ (Show.String$, Show.Len%) STATIC
  214.  
  215.    Show$ = LEFT$(Show.String$ + SPACE$(Show.Len%), Show.Len%)
  216.  
  217. END FUNCTION
  218.  
  219.