home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / STDLIB.ZIP / FLINE.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-04  |  4.2 KB  |  123 lines
  1. '****************************************************************************
  2. 'Total Control Systems                                         QuickBasic 4.5
  3. '****************************************************************************
  4. '
  5. '  Program     : FLINE.BAS
  6. '  Written by  : Tim Beck
  7. '  Written On  : 10-01-90
  8. '  Function    : Print Function Key Line
  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$ (msg$, msg.len%)
  47.     DECLARE SUB ONSCREEN (row%, col%, msg$, csr%, attr%)
  48.     DECLARE SUB PRINTA (xpos%, ypos%, attr%, msg$)
  49.  
  50.     DECLARE SUB F.LINE (Keys$())
  51.   
  52.     '----------------------------------------------------------------------
  53.     '  Print Function Key Line at Row 25
  54.     '
  55.     '  Keys$()     = Keys to Print at Bottom Row (24, 25)
  56.     '
  57.     '
  58.     REM $INCLUDE: 'STDCOM.INC'
  59.  
  60.     TIMER OFF    'Enables Event Trapping
  61.  
  62. SUB F.LINE (Keys$()) STATIC
  63.  
  64.     row% = 25
  65.     num.keys% = UBOUND(Keys$)
  66.     max.wid% = 0
  67.     max.keys% = num.keys%
  68.     key.cnt% = 0
  69.  
  70.     FOR ky% = 1 TO num.keys%
  71.         IF LEN(Keys$(ky%)) > max.wid% THEN
  72.             key.cnt% = ky%
  73.             max.wid% = LEN(Keys$(ky%))
  74.         ELSEIF LEN(Keys$(ky%)) > 0 THEN
  75.             key.cnt% = ky%
  76.         END IF
  77.     NEXT ky%
  78.  
  79.     IF max.wid% = 0 THEN
  80.         CALL ONSCREEN(25, 1, "", 0, HB.attr%)
  81.         EXIT SUB
  82.     ELSEIF key.cnt% < num.keys% THEN
  83.         num.keys% = key.cnt%
  84.     END IF
  85.  
  86.     IF num.keys% MOD 2 <> 0 THEN
  87.         num.keys% = num.keys% + 1
  88.     END IF
  89.  
  90.     Lin.wid% = (num.keys% * 2) + (num.keys% * max.wid%)
  91.     IF Lin.wid% > 80 THEN
  92.         Lin.wid% = Lin.wid% / 2
  93.         max.keys% = num.keys% / 2
  94.         row% = 24
  95.     END IF
  96.     IF Lin.wid% > 80 THEN
  97.         spacer% = 80 - ((max.keys% * 2) + (max.keys% * max.wid%))
  98.     ELSE
  99.         spacer% = 0
  100.     END IF
  101.     DO
  102.         spacer% = spacer% + 1
  103.     LOOP UNTIL (max.keys% * 2) + (max.keys% * (max.wid% + spacer%)) > 80
  104.     spacer% = spacer% - 1
  105.     FOR R% = row% TO 25
  106.         CALL ONSCREEN(R%, 1, "", 0, S.attr%)
  107.     NEXT R%
  108.     FOR ky% = 1 TO num.keys%
  109.         xpos% = ((ky% - 1) * 2) + ((ky% - 1) * (max.wid% + spacer%)) + 1
  110.         IF xpos% > 80 THEN
  111.             xpos% = xpos% - 80
  112.         END IF
  113.         ypos% = row%
  114.         CALL PRINTA(xpos%, ypos%, HB.attr%, "F" + RIGHT$(STR$(ky%), 1))
  115.         CALL PRINTA(xpos% + 2, ypos%, S.attr%, Show$(Keys$(ky%), max.wid% + spacer%))
  116.         IF ky% = max.keys% THEN
  117.             row% = row% + 1
  118.         END IF
  119.     NEXT ky%
  120.  
  121. END SUB
  122.  
  123.