home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / PCENTER.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  4.1 KB  |  122 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : PCENTER.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : PRINT MESSAGE CENTERED BETWEEN COLUMNS C1 AND C2 ON ROW R
  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 Show$ (Show.String$, Show.len%)
  47.  
  48.    DECLARE SUB PCENTER (R%, C1%, C2%, msg$, attr%)
  49.  
  50.    '----------------------------------------------------------------------
  51.    '  Print a Message on Row R% between Columns C1% and C2%
  52.    '
  53.    '  R%       = Row to Print on
  54.    '  C1%, C2% = Columns to Center Between
  55.    '  msg$     = Message to print (truncates if too long)
  56.    '  attr%    = Color Attribute (Fore% + (Back% * 16)) 0 = Screen
  57.  
  58.  
  59.    REM $INCLUDE: 'STDCOM.INC'
  60.  
  61.    TIMER OFF    'Enables Event Trapping
  62.  
  63. '  ON ERROR GOTO ErrorTrap
  64.  
  65. ErrorTrap:
  66.  
  67. '  RESUME
  68.  
  69. SUB PCENTER (R%, C1%, C2%, msg$, attr%) STATIC
  70.  
  71.    IF R% <= 0 OR R% > 25 THEN
  72.       R% = CSRLIN
  73.    END IF
  74.  
  75.    IF C1% <= 0 OR C1% > 80 THEN
  76.       C1% = POS(X)
  77.    END IF
  78.  
  79.    IF C2% <= 0 OR C2% > 80 THEN
  80.       C2% = 80
  81.    END IF
  82.  
  83.    IF attr% = 0 THEN
  84.       attr% = S.attr%
  85.    END IF
  86.  
  87.    LN% = C2% - C1% + 1
  88.    HL% = LN% / 2
  89.    T% = (LN% - (LEN(msg$)))
  90.    T% = T% / 2
  91.    T% = T% - 1
  92.  
  93.    IF C2% < C1% THEN
  94.       EXIT SUB
  95.    ELSEIF T% < 1 THEN
  96.       IF LEN(msg$) > 1 THEN
  97.          msg$ = LEFT$(msg$, LEN(msg$) - 1)
  98.          CALL PCENTER(R%, C1%, C2%, msg$, attr%)
  99.          EXIT SUB
  100.       ELSE
  101.          EXIT SUB
  102.       END IF
  103.    ELSEIF T% + LEN(msg$) > C2% THEN
  104.       IF LEN(msg$) > 1 THEN
  105.          msg$ = LEFT$(msg$, LEN(msg$) - 1)
  106.          CALL PCENTER(R%, C1%, C2%, msg$, attr%)
  107.          EXIT SUB
  108.       ELSE
  109.          EXIT SUB
  110.       END IF
  111.    END IF
  112.  
  113.   'LOCATE R%, C1%
  114.  
  115.   'PRINT TAB(C1% + T%); msg$; TAB(C2%); " ";
  116.  
  117.    msg$ = Show$(SPACE$(T%) + msg$, LN%)
  118.    CALL PRINTA(C1%, R%, attr%, msg$)
  119.  
  120. END SUB
  121.  
  122.