home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PRLIST.ZIP / PRLIST.BAS
BASIC Source File  |  1990-03-31  |  8KB  |  234 lines
  1. DEFINT A-Z
  2.  
  3. DECLARE SUB Prlist (List$(), ListN%, NumInCols%, NumOfCols%, ColW%, Row%, Col%(), KeyCode%, ArrayNum%, Fg%, Bg%)
  4.  
  5. 'PRLIST.BAS, 3/31/90
  6. 'by Gaylon Hill, Route 3, Box 311, Louisville, Tn 37777
  7. '
  8. 'A sub program to print a list of string arrays to the screen
  9. 'in column formats. An array can be selected by using the arrows
  10. 'keys (Home, End, PgUp, PgDn), or by the first letter of the string array.
  11. 'The string array can be buffered with leading blanks, however, the sub
  12. 'will still select by the first letter after the leading blanks.
  13. '
  14. 'CALL Prlist (List$(), ListN, NumInCols, NumOfCols, ColW, Row, Col(),_
  15. '             KeyCode, ArrayNum, Fg, Bg)
  16. 'List$()    = array string list to be displayed.
  17. 'ListN      = number of arrays.
  18. 'NumInCols  = number of arrays to be displayed in each column.
  19. 'NumOfCols  = number of columns to be displayed on each screen.
  20. 'ColW       = the width of each column.
  21. 'Row        = the screen row where the columns will start.
  22. 'Col()      = an integer array that contains the starting place
  23. '             of each column.
  24. '             EX: DIM Col(1 TO 3): Col(1) = 5: Col(2) = 45: Col(3) = 60
  25. 'KeyCode    = the returned code that caused the sub program to end.
  26. '             If the KeyCode in the CALL = 1 then the array strings is
  27. '             is displayed and the SUB is exit immediately (KeyCode then
  28. '             returns a 0 value, and the highlighted line is not displayed).
  29. '             If the KeyCode in the CALL = 2 then the array strings is
  30. '             is displayed with last string array shown and the SUB
  31. '             is exit immediately (KeyCode then returns a 0 value, the
  32. '             highlighted line is not displayed). If the KeyCode = 3 then
  33. '             a highlight line is not displayed, and the SUB is not exit.
  34. '             (KeyCode the returns a 0 value)
  35. '             The F1 key will exit the program and return a KeyCode value
  36. '             of 59. Keys that will exit the program are ENTER, ESC, F1,
  37. '             F2, F3, F4, F5, F6, F7, F8, F9, F10
  38. 'ArrayNum   = the returned array number on exit of SUB program.
  39. '             If ArrayNum in the CALL = a minus number then the page
  40. '             with the selected array string is display.
  41. '             EX: ArrayNum = -100  'array number 100 will be displayed
  42. '                 instead of starting at array number 1, however array
  43. '                 number 100 may not be the first array in the first
  44. '                 column.
  45. 'Fg         = foreground color to print array strings.
  46. 'Br         = background color to print array strings.
  47. '
  48. 'Note: If an array string (List$()) is a NULL then that place on the screen
  49. '      where that array would have been printed is not used. Please note
  50. '      that the first array and the last array in the list should always
  51. '      contains data.
  52.  
  53. 'EXAMPLE 1
  54.  
  55. CLS
  56.  
  57. DIM List$(1 TO 10), Col(1 TO 5)
  58.  
  59. FOR x = 1 TO 10
  60.    READ List$(x)
  61. NEXT
  62.  
  63. LOCATE 20, 10: PRINT "USE    ( Arrow, PgUp, PgDn, Home, End, Enter, F1,"
  64. LOCATE 21, 19: PRINT "F2, F3, F4, F5, F6, F7, F8, F9, F10 )    KEYS"
  65. LOCATE 22, 19: PRINT "or"
  66. LOCATE 23, 19: PRINT "select by first letter of name"
  67.  
  68. ListN = 10: NumInCols = 6: NumOfCols = 2: ColW = 20: Row = 5
  69. Col(1) = 15: Col(2) = 45: Fg = 0: Fg = 7
  70. CALL Prlist(List$(), ListN, NumInCols, NumOfCols, ColW, Row, Col(), KeyCode, ArrayNum, Fg, Bg)
  71.  
  72. LOCATE 14, 15: PRINT "KeyCode      = "; KeyCode
  73. LOCATE 15, 15: PRINT "ArrayNum     = "; ArrayNum
  74. LOCATE 16, 15: PRINT "String Array =  "; List$(ArrayNum)
  75.  
  76. 'Example 2:
  77.  
  78. ListN = 5: NumInCols = 1: NumOfCols = 5: ColW = 13: Row = 1
  79. Col(1) = 1: Col(2) = 18: Col(3) = 34: Col(4) = 49: Col(5) = 64
  80. Fg = 0: Fg = 7
  81. CALL Prlist(List$(), ListN, NumInCols, NumOfCols, ColW, Row, Col(), KeyCode, ArrayNum, Fg, Bg)
  82.  
  83.  
  84.  
  85. DATA Frank A Jones, June N Jones, Terry A Jones, Jeff T Jones, Alfred Jones
  86. DATA Frank A Smith, June N Smith, Terry A Smith, Jeff T Smith, Alfred Smith
  87.  
  88. '
  89. SUB Prlist (List$(), ListN, NumInCols, NumOfCols, ColW, Row, Col(), KeyCode, ArrayNum, Fg, Bg)
  90.  
  91.    CONST ENTER = 13, ESC = 27, DOWN = -80, HOME = -71
  92.    CONST UP = -72, PGUP = -73, PGDN = -81
  93.    CONST LEFT = -75, RIGHT = -77, ENDKEY = -79
  94.    CONST F1 = -59, F2 = -60, F3 = -61, F4 = -62, F5 = -63
  95.    CONST F6 = -64, F7 = -65, F8 = -66, F9 = -67, F10 = -68
  96.  
  97.    TRUE = 1: Findx = 1: LastStartPr = -1
  98.    LR = Row: LCol = Col(1): Lx = Findx
  99.    IF ArrayNum < 0 THEN
  100.       Findx = ABS(ArrayNum)
  101.       GOSUB TestFindx
  102.    END IF
  103.    IF KeyCode = 1 THEN
  104.       KeyCode = 3
  105.       GOSUB PrintRoutine
  106.       KeyCode = 0
  107.       EXIT SUB
  108.    END IF
  109.    IF KeyCode = 2 THEN
  110.       Findx = ListN: KeyCode = 3
  111.       GOSUB PrintRoutine
  112.       KeyCode = 0
  113.       EXIT SUB
  114.    END IF
  115.    GOSUB PrintRoutine
  116.  
  117.    DO
  118.       DO
  119.          i$ = INKEY$
  120.       LOOP UNTIL LEN(i$)
  121.  
  122.       IF LEN(i$) = 1 THEN
  123.          KeyC = ASC(i$)
  124.       ELSE
  125.          KeyC = -ASC(RIGHT$(i$, 1))
  126.       END IF
  127.  
  128.       SELECT CASE KeyC
  129.          CASE 33 TO 126
  130.             FoundIt = 0
  131.             FOR x = Findx + 1 TO ListN
  132.                S$ = LTRIM$(List$(x))
  133.                IF UCASE$(MID$(S$, 1, 1)) = UCASE$(CHR$(KeyC)) THEN
  134.                   Findx = x
  135.                   FoundIt = 1
  136.                   EXIT FOR
  137.                END IF
  138.             NEXT
  139.             IF FoundIt = 0 THEN
  140.                FOR x = 1 TO Findx
  141.                   S$ = LTRIM$(List$(x))
  142.                   IF UCASE$(MID$(S$, 1, 1)) = UCASE$(CHR$(KeyC)) THEN
  143.                      Findx = x
  144.                      EXIT FOR
  145.                   END IF
  146.                NEXT
  147.             END IF
  148.          CASE ENTER, ESC, F1, F2, F3, F4, F5, F6, F7, F8, F9, F10
  149.             KeyCode = ABS(KeyC)
  150.             ArrayNum = Findx
  151.             EXIT SUB
  152.          CASE ENDKEY
  153.             Findx = ListN
  154.          CASE HOME
  155.             Findx = 1
  156.          CASE LEFT
  157.             Findx = Findx - NumInCols
  158.          CASE RIGHT
  159.             Findx = Findx + NumInCols
  160.          CASE UP
  161.             Findx = Findx - 1
  162.          CASE DOWN
  163.             Findx = Findx + 1
  164.          CASE PGUP
  165.             Findx = Findx - (NumInCols * NumOfCols)
  166.          CASE PGDN
  167.             Findx = Findx + (NumInCols * NumOfCols)
  168.       END SELECT
  169.       GOSUB TestFindx
  170.       GOSUB PrintRoutine
  171.    LOOP WHILE TRUE
  172.  
  173. PrintRoutine:
  174.    R = Row: ColCnt = 1: Col = Col(ColCnt)
  175.    StartPr = ((Findx - 1) \ (NumInCols * NumOfCols)) * (NumInCols * NumOfCols)
  176.    IF LastStartPr = StartPr THEN
  177.       sw = 1
  178.    END IF
  179.    LastStartPr = StartPr
  180.    FOR xx = 1 TO (NumInCols * NumOfCols)
  181.       COLOR Fg, Bg
  182.       x = StartPr + xx
  183.       IF sw = 0 THEN
  184.          IF x < ListN + 1 THEN
  185.             IF List$(x) <> "" THEN
  186.                LOCATE R, Col: PRINT LEFT$(List$(x) + SPACE$(ColW), ColW);
  187.             END IF
  188.          ELSE
  189.             LOCATE R, Col: PRINT SPACE$(ColW);
  190.          END IF
  191.       END IF
  192.       IF x = Findx AND KeyCode <> 3 THEN
  193.          IF sw = 1 THEN
  194.             LOCATE LR, LCol: PRINT LEFT$(List$(Lx) + SPACE$(ColW), ColW);
  195.          END IF
  196.          COLOR Bg, Fg
  197.          LOCATE R, Col: PRINT LEFT$(List$(x) + SPACE$(ColW), ColW);
  198.          LR = R: LCol = Col: Lx = x
  199.       END IF
  200.       RowCnt = RowCnt + 1
  201.       R = R + 1
  202.       IF RowCnt = NumInCols THEN
  203.          ColCnt = ColCnt + 1
  204.          R = Row
  205.          IF ColCnt > NumOfCols THEN
  206.             ColCnt = NumOfCols
  207.          END IF
  208.          Col = Col(ColCnt)
  209.          RowCnt = 0
  210.       END IF
  211.    NEXT
  212.    sw = 0: R = Row
  213.    RETURN
  214.    
  215. TestFindx:
  216.    IF Findx < 1 THEN
  217.       Findx = 1
  218.    END IF
  219.    IF Findx > ListN THEN
  220.       Findx = ListN
  221.    END IF
  222.    IF KeyC = DOWN AND List$(Findx) = "" THEN
  223.       Findx = Findx + 1
  224.       GOTO TestFindx
  225.    END IF
  226.    IF KeyC = UP AND List$(Findx) = "" THEN
  227.       Findx = Findx - 1
  228.       GOTO TestFindx
  229.    END IF
  230.    RETURN
  231.  
  232. END SUB
  233.  
  234.