home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / BANNER.BAS next >
Encoding:
BASIC Source File  |  1990-10-04  |  4.1 KB  |  120 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : BANNER.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : BANNER SUBROUTINE
  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 SUB PCENTER (R%, C1%, C2%, msg$, attr%)
  47.    DECLARE SUB BANNER (Row%, L.Side$, Center$, R.Side$, LType%)
  48.  
  49.    '------------------------------------------------------------------------
  50.    '  Print a Banner on the Screen
  51.    '
  52.    '  ie:   ======================================
  53.    '        Left Text    Center Text    Right Text
  54.    '        ======================================
  55.    '
  56.    '  Row%     = Bottom Row of Banner
  57.    '  L.Side$  = Left Side Text
  58.    '  Center$  = Center Text
  59.    '  R.Side$  = Right Side Text
  60.    '  LType%   = Line Type (0 = No Line, 1 = Single Line, 2 = Double Line)
  61.    '
  62.  
  63.  
  64.    REM $INCLUDE: 'STDCOM.INC'
  65.  
  66.    TIMER OFF    'Enables event trapping
  67.  
  68. '   ON ERROR GOTO ErrorTrap
  69.  
  70. ErrorTrap:
  71.  
  72. '   RESUME
  73.  
  74.  
  75. SUB BANNER (Row%, L.Side$, Center$, R.Side$, LType%) STATIC
  76.  
  77.    L.Bord% = SCREEN(Row%, 1)
  78.    R.Bord% = SCREEN(Row%, 80)
  79.  
  80.    IF LType% = 0 THEN
  81.       B.Line% = 32
  82.    ELSEIF LType% = 1 THEN
  83.       B.Line% = 196
  84.    ELSE
  85.       B.Line% = 205
  86.    END IF
  87.  
  88.    IF L.Bord% = 186 THEN
  89.       IF LType% = 1 THEN
  90.          L.Bord% = 199
  91.       ELSE
  92.          L.Bord% = 204
  93.       END IF
  94.    END IF
  95.  
  96.    IF R.Bord% = 186 THEN
  97.       IF LType% = 1 THEN
  98.          R.Bord% = 182
  99.       ELSE
  100.          R.Bord% = 185
  101.       END IF
  102.    END IF
  103.  
  104.    IF LEN(L.Side$) THEN
  105.       CALL PRINTA(2, Row%, S.attr%, L.Side$)
  106.    END IF
  107.  
  108.    IF LEN(Center$) THEN
  109.       CALL PCENTER(Row%, 2 + LEN(L.Side$), 80, Center$, S.attr%)
  110.    END IF
  111.  
  112.    IF LEN(R.Side$) THEN
  113.       CALL PRINTA(80 - LEN(R.Side$), Row%, S.attr%, R.Side$)
  114.    END IF
  115.  
  116.    CALL PRINTA(1, Row% + 1, S.attr%, CHR$(L.Bord%) + STRING$(78, B.Line%) + CHR$(R.Bord%))
  117.  
  118. END SUB
  119.  
  120.