home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / baswind8.zip / POPLIST.SUB < prev    next >
Text File  |  1990-09-14  |  31KB  |  886 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : POPLIST                                       *
  5. '                                                                             *
  6. ' Purpose:                                                                    *
  7. '                                                                             *
  8. '                                                                             *
  9. ' Results:                                                                    *
  10. '                                                                             *
  11. ' Usage  :                                                                    *
  12. '                                                                             *
  13. '                                                                             *
  14. ' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
  15. ' Date Modified:          -            :          -       :                   *
  16. '-----------------------------------------------------------------------------*
  17. ' NOTE:                                                                       *
  18. '******************************************************************************
  19. '                                                                             *
  20. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  21. '-----------------------------------------------------------------------------*
  22. '                                                                             *
  23. SUB    POPLIST(HEADER$,SHOWITEMS%,MAXITEMS%,ITEM$(1),FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SELECT.%,RETURN.CODE%)  STATIC
  24.  
  25.        DEFINT A-Z                               'make all short intergers by default
  26.  
  27.        RETURN.CODE%=0
  28.        MAKEWIND.RETURN.CODE%=0
  29.        SETQUAD.RETURN.CODE%=0
  30.        VIDEO.RETURN.CODE%=0
  31.  
  32.        ITEM.MIN=LBOUND(ITEM$)                   'adjust for callers OPTION BASE
  33.        ITEM.MAX=UBOUND(ITEM$)                   'save array upper limits
  34.  
  35.        SELECT.BASE=1-ITEM.MIN                   'normalize to a base of 1
  36.  
  37. '
  38. ' add code to check that MAXITEMS dosnt go outside array bounds (+ or -)
  39. '
  40.        IF SHOWITEMS%> MAXITEMS% THEN            'we cant show more than whats avail
  41.            SHOWITEMS%=MAXITEMS%
  42.        END IF
  43.  
  44.        TEMP.ITEM$=STRING$(255," ")
  45.  
  46.        BEGVAL=1
  47.  
  48.        MENU.TOP.ROW=0
  49.        MENU.TOP.LEFT.COL=0
  50.        MENU.BOTTOM.ROW=0
  51.        MENU.BOTTOM.RIGHT.COL=0
  52.  
  53.        BUTTONS%=0                               'assume no mouse support avail
  54.  
  55.        CALL MMCHECK(BUTTONS%)                   'see if mouse support avail
  56.  
  57.        GOSUB POPLIST.MMCURSORON
  58.  
  59.        MOUSECOL=0                               'locate the mouse cursor in upper
  60.        MOUSEROW=0                               'left top corner of screen
  61.  
  62.        CALL MMSETLOC(MOUSECOL,MOUSEROW)         'move the mouse cursor
  63.  
  64.        FIRST.TIME=-1
  65.  
  66.        GOSUB POPLIST.MMCURSOROFF
  67.  
  68. '
  69.        WINDLEN=LEN(HEADER$)                     'assume window length is header length
  70.  
  71. 'Determine width of window from length of longest item
  72.        FOR J=ITEM.MIN TO ITEM.MIN+MAXITEMS%
  73.            ASCIIZ=INSTR(ITEM$(J),CHR$(0))       'a string may have imbedded
  74.            LEN.ITEM=ASCIIZ-1                    'null x'00', to allow only part
  75.                                                 'of string to be displayed
  76.            IF LEN.ITEM<1 THEN
  77.                LEN.ITEM=LEN(ITEM$(J))
  78.            END IF
  79.  
  80.            IF LEN.ITEM > WINDLEN THEN
  81.                 WINDLEN=LEN.ITEM
  82.            END IF
  83.  
  84.        NEXT
  85.  
  86.        LENGTH.MENU.ITEM=WINDLEN                 'this is the length of the longest item
  87.  
  88. 'If Quadrant is in ROW:COL format, extract Row and Column
  89.  
  90.        IF INSTR(QUADRANT$,":")<>0 THEN          'was an absolute row:column specified
  91.            GOSUB POPLIST.GETORD
  92.          GOTO POPLIST.GO1
  93.        END IF
  94.  
  95. 'Determine Position based on Quadrant Parameter and size of menu
  96.  
  97.        QUADRANT=VAL(QUADRANT$)                  'The window is to be in 1 of the 5 quadrants
  98.  
  99.        IF QUADRANT <0 OR QUADRANT >4 THEN       'make sure the quadrant is valid
  100.            QUADRANT=0                           'if invalid, default to center of screen
  101.        END IF
  102.  
  103.        CALL SETQUAD(QUADRANT,CROW,CCOL,WINDLEN,SHOWITEMS%,SETQUAD.RETURN.CODE)
  104.  
  105.        ULR%=CROW-(((SHOWITEMS%+2)/2)-.5)        'the upper left row:column window co-ordinates
  106.        ULC%=CCOL-((WINDLEN/2)-.5)
  107.        LRR%=ULR%+SHOWITEMS%+1                   'the lower right window co-ordinates
  108.        LRC%=ULC%+WINDLEN-1
  109.  
  110. '
  111. 'Create Window for List
  112. POPLIST.GO1:
  113.        MENU.TOP.ROW=ULR%+2                      'allow for the menu name box above the window
  114.        MENU.TOP.LEFT.COL=ULC%
  115.        MENU.BOTTOM.ROW=LRR%
  116.        MENU.BOTTOM.RIGHT.COL=LRC%
  117.  
  118.        FRAME%=4
  119.  
  120.        CALL MAKEWIND(ULR%,ULC%,LRR%,LRC%,FRAME,FORE%,BACK%,GROW,SHADOW%,LABEL$,MAKEWIND.RETURN.CODE)
  121.  
  122.        TEMPHDR$=SPACE$(WINDLEN)                 'make menu header as big as biggest item
  123.  
  124.        IF LEN(HEADER$)<>WINDLEN THEN            'does the menu header need centering?
  125.             GOSUB POPLIST.PUTHDR                'YES
  126.        END IF
  127.  
  128.        ATTR=(HBACK% AND 7)*16+HFORE%            'display the menu header
  129.        ROW=ULR%
  130.        COL=ULC%
  131.        CALL FASTPRT(HEADER$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
  132.  
  133.        ATTR=(BACK% AND 7)*16+FORE%              'bracket the menu header in the window
  134.        ROW=ULR%+1
  135.        COL=ULC%
  136.        DAT$=STRING$(WINDLEN,205)
  137.        CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
  138.  
  139. 'Set current choice to List Item #1, Set Beginning and Ending values,
  140. 'Display 'More...' message and enter Loop
  141.  
  142.  
  143.        IF (SELECT.%<1) OR (SELECT.%>MAXITEMS%) THEN 'is first item to be displayed valid range?
  144.           SELECT.%=1                                'NO, so display first one by default
  145.        END IF
  146.  
  147.        FIRST.SELECT=SELECT.%                        'remember the first item to display
  148.  
  149.        SELECT.%=1                                   'display the first group of items
  150.        OLD=SELECT.%
  151.  
  152.        BEGVAL=SELECT.%                              'starting with the first item
  153.        ENDVAL=SHOWITEMS%                            'and ending with the max we can display at once
  154.  
  155.        GOSUB POPLIST.FILL
  156.  
  157.        IF FIRST.SELECT<>1 THEN                      'do we really want to display another item first?
  158.           TEMP.SELECT=FIRST.SELECT                  'yes, make it so
  159.           GOSUB POPLIST.FOUND.IT
  160.        END IF
  161.  
  162.        FIRST.TIME=0
  163.  
  164. '
  165. POPLIST.LOOP:
  166.        GOSUB POPLIST.PRESS                          'Get KeyPress
  167.  
  168.        IF KP$=CHR$(13) OR KP$=CHR$(27) THEN         'was Enter or ESC key pressed?
  169.            GOTO POPLIST.DONE                        'yes, were are thru
  170.        END IF
  171.  
  172.        GOTO POPLIST.LOOP                            'keep waiting for user to press a key
  173.  
  174. '
  175. 'Check for KeyPress and sound error if not UP ARROW, DOWN ARROW, HOME, END, PAGE UP, PAGE DOWN, or RETURN
  176. POPLIST.PRESS:
  177.        CLICK=-1                                     'flush any mouse clicks
  178.        DO WHILE CLICK
  179.           LFT%=0
  180.           RGT%=0
  181.           CALL MMCLICK(LFT%,RGT%)
  182.           CLICK=LFT%+RGT%
  183.        LOOP
  184.  
  185.        GOSUB POPLIST.GET.PRESS
  186.  
  187.        IF KP$="" THEN                                'wait for a key or mouse click
  188.            GOTO POPLIST.PRESS
  189.        END IF
  190.  
  191.        IF LEN(KP$)=2 THEN                            'was an extended function key pressed?
  192.            GOTO POPLIST.DOWN                         'yes
  193.        END IF
  194.  
  195. POPLIST.PRESS.ON:
  196.        IF KP$=CHR$(13) THEN                          'Enter key pressed?
  197.            RETURN
  198.        END IF
  199.  
  200.        IF KP$=CHR$(27) THEN                          'ESC key pressed
  201.            SELECT.%=0                                'nothing noted as being selected
  202.          RETURN
  203.        END IF
  204.  
  205.        GOSUB POPLIST.FIND.OPTION                     'find the first char of an item that matches key pressed
  206.  
  207.        IF SELECT.%<>SAVE.SELECT THEN                 'was a new item found?
  208.            RETURN                                    'YES
  209.        END IF
  210.  
  211.        GOSUB POPLIST.SOUNDOFF                        'NO, a new item not found!
  212.        GOTO POPLIST.PRESS
  213.  
  214. '
  215. 'Process DOWN ARROW KeyPress
  216. POPLIST.DOWN:
  217.        IF ASC(RIGHT$(KP$,1))=80 THEN                 'was cursor down key pressed?
  218.            SELECT.%=SELECT.%+1                       'this is the new item we want highlighted
  219.        ELSE
  220.            GOTO POPLIST.UP                           'NO, see if cursor up
  221.        END IF
  222.  
  223.        IF SELECT.% > MAXITEMS% THEN                  'are we at the end of the items?
  224.            IF SHOWITEMS%=MAXITEMS% THEN              'is this a POPMENU
  225.                 BEGVAL=1                             'loop back to top of menu items
  226.                 OLD=MAXITEMS%                        'point to current item highlighted
  227.                 SELECT.%=1                           'point to next item to highlight
  228.                 ENDVAL=MAXITEMS%                     'point to last menu item to display
  229.                 GOSUB POPLIST.FILL
  230.               RETURN
  231.            ELSE
  232.                 SELECT.% = MAXITEMS%                 'cant go past the end!
  233.                 GOSUB POPLIST.SOUNDOFF
  234.               RETURN
  235.            END IF
  236.        END IF
  237.  
  238.        IF (SELECT.% > ENDVAL) AND (SELECT.% = MAXITEMS%) THEN
  239.             BEGVAL=BEGVAL+1
  240.             ENDVAL=ENDVAL+1
  241.             OLD=0
  242.             GOSUB POPLIST.FILL
  243.           RETURN
  244.        END IF
  245.  
  246. '
  247. ' have we requested an item on the next screen of items
  248. '
  249.        IF (SELECT.% > ENDVAL) AND (SELECT.% <> MAXITEMS%) THEN
  250.             BEGVAL=BEGVAL+1
  251.             ENDVAL=ENDVAL+1
  252.             OLD=0
  253.             GOSUB POPLIST.FILL
  254.           RETURN
  255.        END IF
  256.  
  257. '
  258. ' highlight the next item
  259. '
  260.        GOSUB POPLIST.FILL
  261.        RETURN
  262.  
  263. '
  264. 'Process UP ARROW KeyPress
  265. POPLIST.UP:
  266.        IF ASC(RIGHT$(KP$,1))=72 THEN                 'was cursor up key pressed?
  267.            SELECT.%=SELECT.%-1                       'this is the new item we want highlighted
  268.        ELSE
  269.            GOTO POPLIST.PG.UP                        'NO, see if page up
  270.        END IF
  271.  
  272.        IF SELECT.% < 1 THEN                          'are we at the top of the items?
  273.            IF SHOWITEMS%=MAXITEMS% THEN              'is this a POPMENU
  274.                BEGVAL=1                              'loop back to bottom of menu items
  275.                OLD=BEGVAL                            'point to current highlighted item
  276.                SELECT.%=MAXITEMS%                    'point to next item to highlight
  277.                ENDVAL=MAXITEMS%                      'point to last item to display
  278.                GOSUB POPLIST.FILL
  279.              RETURN
  280.          ELSE
  281.               SELECT.% = 1                           'cant go past the top!
  282.               GOSUB POPLIST.SOUNDOFF
  283.             RETURN
  284.          END IF
  285.        END IF
  286.  
  287.        IF (SELECT.% < BEGVAL) AND (SELECT.% = 1) THEN
  288.             BEGVAL=BEGVAL-1
  289.             ENDVAL=ENDVAL-1
  290.             OLD=0
  291.             GOSUB POPLIST.FILL
  292.           RETURN
  293.        END IF
  294.  
  295. '
  296. ' have we requested an item on the next screen of items
  297. '
  298.        IF (SELECT.% < BEGVAL) AND (SELECT.% <> 1) THEN
  299.             BEGVAL=BEGVAL-1
  300.             ENDVAL=ENDVAL-1
  301.             OLD=0
  302.             GOSUB POPLIST.FILL
  303.           RETURN
  304.        END IF
  305.  
  306. '
  307. ' highlight the next item
  308. '
  309.        GOSUB POPLIST.FILL
  310.        RETURN
  311.  
  312. '
  313. 'Process PAGE UP KeyPress
  314. POPLIST.PG.UP:
  315.        IF ASC(RIGHT$(KP$,1))=73 THEN                 'was page up  key pressed?
  316.            OLD=SELECT.%                              'this is the current item highlighted
  317.            SELECT.%=SELECT.%-SHOWITEMS%              'this is the new item we want highlighted
  318.        ELSE
  319.            GOTO POPLIST.PG.DN                        'NO, see if cursor down
  320.        END IF
  321.  
  322.        IF SELECT.% < 1 THEN                          'are we at the first screen of items?
  323.             KP$=CHR$(0)+CHR$(79)                     'simulate a END key press
  324.             SELECT.%=OLD
  325.           GOTO POPLIST.ENDK
  326.        END IF
  327.  
  328.        BEGVAL=BEGVAL-SHOWITEMS%                      'calculate the first and last items in next screen
  329.        ENDVAL=ENDVAL-SHOWITEMS%
  330.  
  331.        IF BEGVAL < 1 THEN                            'we cant go past first item
  332.            BEGVAL=1                                  'point to first item
  333.            ENDVAL=SHOWITEMS%
  334.        END IF
  335.  
  336.        GOSUB POPLIST.FILL                            'highlight the item
  337.        RETURN
  338.  
  339. '
  340. 'Process PAGE DOWN KeyPress
  341. POPLIST.PG.DN:
  342.        IF ASC(RIGHT$(KP$,1))=81 THEN                 'was page down  key pressed?
  343.            OLD=SELECT.%                              'this is the current item highlighted
  344.            SELECT.%=SELECT.%+SHOWITEMS%              'this is the new item we want highlighted
  345.        ELSE
  346.            GOTO POPLIST.HOME                         'NO, see if home pressed
  347.        END IF
  348.  
  349.        IF SELECT.% > MAXITEMS% THEN                  'are we at the last screen of items?
  350.           IF ENDVAL>=MAXITEMS% THEN
  351.               KP$=CHR$(0)+CHR$(71)                   'simulate a HOME key press
  352.               SELECT.%=OLD
  353.             GOTO POPLIST.HOME
  354.           END IF
  355.        END IF
  356.  
  357.        BEGVAL=BEGVAL+SHOWITEMS%                      'calculate the first and last items in next screen
  358.        ENDVAL=ENDVAL+SHOWITEMS%
  359.  
  360.        IF ENDVAL > MAXITEMS% THEN                    'we cant go past the last item
  361.            ENDVAL=MAXITEMS%                          'point to last item
  362.            BEGVAL=(ENDVAL-SHOWITEMS%)+1
  363.            OLD=ENDVAL
  364.            SELECT.%=OLD
  365.  
  366.        END IF
  367.  
  368.        GOSUB POPLIST.FILL                            'highlight the item
  369.        RETURN
  370.  
  371. '
  372. 'Process HOME KeyPress
  373. POPLIST.HOME:
  374.        IF ASC(RIGHT$(KP$,1))=71 THEN                 'was home key pressed?
  375.            OLD=SELECT.%                              'this is the current item highlighted
  376.        ELSE
  377.            GOTO POPLIST.ENDK                         'NO, see if end key pressed
  378.        END IF
  379.  
  380.        IF SELECT.%=1 THEN
  381.             GOSUB POPLIST.SOUNDOFF
  382.           RETURN
  383.        END IF
  384.  
  385.        SELECT.%=1                                    'display the first group of items
  386.        OLD=SELECT.%                                  'force new screen re-display
  387.        BEGVAL=1                                      'point to the first item
  388.        ENDVAL=BEGVAL+SHOWITEMS%-1                    'and display the first screen of this many items
  389.        GOSUB POPLIST.FILL
  390.        RETURN
  391.  
  392. '
  393. 'Process END KeyPress
  394. POPLIST.ENDK:
  395.        IF ASC(RIGHT$(KP$,1))=79 THEN                 'was end key pressed?
  396.            OLD=SELECT.%                              'this is the current item highlighted
  397.        ELSE
  398.            GOTO POPLIST.ERRCHK                       'NO, let user know invalid key pressed
  399.        END IF
  400.  
  401.        IF SELECT.%=MAXITEMS% THEN
  402.             GOSUB POPLIST.SOUNDOFF
  403.           RETURN
  404.        END IF
  405.  
  406.        SELECT.%=MAXITEMS%                            'display the last group of items
  407.        OLD=SELECT.%                                  'force new screen re-display
  408.        ENDVAL=MAXITEMS%                              'point to the last item
  409.        BEGVAL=ENDVAL-SHOWITEMS%+1                    'display screen of last group of items
  410.  
  411.        GOSUB POPLIST.FILL
  412.        RETURN
  413.  
  414. '
  415. 'Process ERROR
  416. POPLIST.ERRCHK:
  417.        GOSUB POPLIST.SOUNDOFF                        'let user know problem/error
  418.        GOTO POPLIST.PRESS
  419.  
  420. '
  421. 'Fill Contents of window
  422. POPLIST.FILL:
  423.        IF BEGVAL < 1 THEN                             'make sure we dont go out of bounds
  424.            BEGVAL=1
  425.        END IF
  426.  
  427.        IF ENDVAL > MAXITEMS% THEN                     'make sure we dont go past the end of the items
  428.            ENDVAL=MAXITEMS%
  429.        END IF
  430.  
  431.        OFFSET=ENDVAL-SELECT.%
  432.  
  433.        IF OFFSET < 0 THEN
  434.            OFFSET = 0
  435.        ELSEIF OFFSET > SHOWITEMS%-1 THEN
  436.            OFFSET = SHOWITEMS%-1
  437.        END IF
  438.  
  439.        GOSUB POPLIST.MMCURSOROFF
  440.  
  441. '
  442. ' If next item to be hi-lited is on same screen already display, dont re-
  443. ' display all options, BUT turn off current hi-lited option and just turn
  444. ' on next item to be hi-lited (on this screen of options).
  445. '
  446.        IF OLD<>SELECT.% THEN
  447.           IF (OLD>=BEGVAL) AND (OLD<=ENDVAL) THEN
  448.                ATTR=(BACK% AND 7)*16+FORE%
  449.  
  450.                ROW=ROW
  451.                COL=ULC%
  452.  
  453.                DAT$=ITEM$(OLD-SELECT.BASE)
  454.  
  455.                ASCIIZ=INSTR(DAT$,CHR$(0))             'display ONLY the string upto
  456.                IF ASCIIZ>1 THEN                       'a null x'00' if one is imbedded
  457.                    DAT$=LEFT$(DAT$,ASCIIZ-1)
  458.                END IF
  459.  
  460.                DAT$=DAT$+SPACE$(WINDLEN)              'make all items the same length
  461.                DAT$=LEFT$(DAT$,WINDLEN)               'when they are displayed
  462.  
  463.                CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
  464.             GOTO POPLIST.HILITE
  465.           END IF
  466.        END IF
  467.  
  468.  
  469. '
  470.        K=1
  471.  
  472. '
  473. ' display the group of items we need
  474. '
  475.  
  476.        FOR J=BEGVAL TO ENDVAL
  477.            ATTR=(BACK% AND 7)*16+FORE%
  478.            ROW=(ULR%+1+K)
  479.            COL=ULC%
  480.            DAT$=ITEM$(J-SELECT.BASE)
  481.  
  482.            ASCIIZ=INSTR(DAT$,CHR$(0))           'display ONLY the string upto
  483.            IF ASCIIZ>1 THEN                     'a null x'00' if one is imbedded
  484.                DAT$=LEFT$(DAT$,ASCIIZ-1)
  485.            END IF
  486.  
  487.            DAT$=DAT$+SPACE$(WINDLEN)            'make all items the same length
  488.            DAT$=LEFT$(DAT$,WINDLEN)             'when they are displayed
  489.  
  490.            CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
  491.  
  492.            K=K+1
  493.        NEXT
  494.  
  495.  
  496. '
  497. 'highlight the next item displayed
  498. POPLIST.HILITE:
  499.        ATTR=(FORE% AND 7)*16+BACK%
  500.  
  501.        IF BEGVAL=1 AND SELECT.%=1 THEN
  502.             ROW=ULR%+2
  503.        ELSEIF (SELECT.% >= BEGVAL) AND (SELECT.% <= ENDVAL) THEN
  504.             ROW=ULR%+2+SELECT.%
  505.        END IF
  506.  
  507.        IF (ENDVAL=MAXITEMS%) AND (SELECT.%>=MAXITEMS%) THEN
  508.             SELECT.%=MAXITEMS%
  509.             ROW=LRR%
  510.        ELSE
  511.             ROW=LRR%-OFFSET
  512.        END IF
  513.  
  514.        COL=ULC%
  515.        DAT$=ITEM$(SELECT.%-SELECT.BASE)
  516.  
  517.        ASCIIZ=INSTR(DAT$,CHR$(0))               'display ONLY the string upto
  518.        IF ASCIIZ>1 THEN                         'a null x'00' if one is imbedded
  519.            DAT$=LEFT$(DAT$,ASCIIZ-1)
  520.        END IF
  521.  
  522.        DAT$=DAT$+SPACE$(WINDLEN)                'make all items the same length
  523.        DAT$=LEFT$(DAT$,WINDLEN)                 'when they are displayed
  524.  
  525. '
  526. ' display this selected item, and highlight it
  527.        CALL FASTPRT(DAT$,ROW,COL,ATTR,VIDEO.RETURN.CODE)
  528.  
  529.        IF FIRST.TIME THEN
  530.            MOUSEROW=(ROW-1)*8               'if so, put the mouse cursor on the new selection
  531.            MOUSECOL=(COL+(LEN(DAT$)\2)-1)*8
  532.            CALL MMSETLOC(MOUSECOL,MOUSEROW)
  533.        END IF
  534.  
  535.        OLD=SELECT.%                         'fixes problem with item being highlighed twice
  536.  
  537.        GOSUB POPLIST.MORE                   'put arrows on top and bottom of window
  538.  
  539.        CLICK=-1
  540.        DO WHILE CLICK                       'flush mouse click , if holding down button
  541.           LFT%=0
  542.           RGT%=0
  543.           CALL MMCLICK(LFT%,RGT%)
  544.           CLICK=LFT%+RGT%
  545.        LOOP
  546.  
  547.        GOSUB POPLIST.MMCURSORON
  548.        RETURN
  549.  
  550. '
  551. 'Display arrowhead on top or bottom of window as necessary
  552. POPLIST.MORE:
  553.        IF SHOWITEMS%=MAXITEMS% THEN         'are we doing POPMENU
  554.             RETURN                          'yes, all items displayed at once
  555.        END IF
  556.  
  557.        MCOL=ULC%+((LRC%-ULC%)/2)-3           'calculate the windows upper frame location
  558.  
  559.        DAT$=" "+CHR$(30)+" "+CHR$(205)+" "+CHR$(31)+" "
  560.  
  561.        MROW=ULR%+1
  562.        GOSUB POPLIST.DISP
  563.  
  564.        MROW=LRR%+1
  565.        GOSUB POPLIST.DISP
  566.  
  567.        RETURN
  568.  
  569. '
  570. POPLIST.DISP:
  571.        ATTR=(BACK% AND 7)*16+FORE%
  572.        CALL FASTPRT(DAT$,MROW,MCOL,ATTR,VIDEO.RETURN.CODE)
  573.        RETURN
  574.  
  575. '
  576. '
  577. ' Scan the list of items item looking for an item whose fitst character
  578. 'matches the keyboard character the user just typed.
  579. '
  580. POPLIST.FIND.OPTION:
  581.        SAVE.SELECT=SELECT.%                 'save the current item highlighted
  582.        TEMP.SELECT=SELECT.%
  583.        FIRST.CHAR$=KP$                      'this is the character to look for
  584.  
  585. 'make comparison test case in-sensative
  586. '
  587.        FIRST.CHAR$=UCASE$(FIRST.CHAR$)
  588.  
  589.        COUNT=0                              'how many items have looked at
  590. POPLIST.FIND.LOOP:
  591.        TEMP.SELECT=TEMP.SELECT+1            'look at the item after the current one
  592.        IF TEMP.SELECT>MAXITEMS% THEN        'are we at the end of the list
  593.            TEMP.SELECT=1                    'Yes start back at the first item in the list
  594.        END IF
  595.  
  596.        COUNT=COUNT+1                        'we have looked at this many items so far
  597.        IF COUNT>MAXITEMS% THEN              'have we looked at all the items in the list
  598.            RETURN                           'YES
  599.        END IF
  600.  
  601.        MID$(TEMP.ITEM$,1)=ITEM$(TEMP.SELECT-SELECT.BASE)
  602.        LEN.TEMP.ITEM=LEN(ITEM$(TEMP.SELECT-SELECT.BASE))
  603.  
  604. '
  605. 'scan over leading spaces for this item, up to first character
  606. '
  607.        FOR I=1 TO LEN.TEMP.ITEM
  608.        IF MID$(TEMP.ITEM$,I,1)<>" " THEN
  609. '
  610. 'make comparison test case in-sensative
  611. '
  612.            IF UCASE$(MID$(TEMP.ITEM$,I,1))=FIRST.CHAR$ THEN
  613.                GOTO POPLIST.FOUND.IT        'this one was a match
  614.            ELSE
  615.              GOTO POPLIST.FIND.LOOP         'not this one, keep looking
  616.            END IF
  617.        END IF
  618.  
  619.        NEXT
  620.  
  621.        GOTO POPLIST.FIND.LOOP               'not this one, keep looking
  622.  
  623. '
  624. POPLIST.FOUND.IT:
  625.        SELECT.%=TEMP.SELECT                   'this is the item to select now
  626.  
  627.        IF (SELECT.%>=BEGVAL) AND (SELECT.%<=ENDVAL) THEN 'new item on diff. screen
  628.           GOTO POPLIST.FOUND.IT.CONT          'no
  629.        ENDIF
  630.  
  631.        OLD=SELECT.%                           'yes, force new screen re-display
  632.        BEGVAL=SELECT.%                        'start the display window with this item
  633.        ENDVAL=(BEGVAL+SHOWITEMS%)-1           'and end with this item
  634.  
  635.        IF ENDVAL > MAXITEMS% THEN             'are there enought items to fill this window
  636.            ENDVAL=MAXITEMS%                   'NO, so display the last group of items
  637.            BEGVAL=(ENDVAL-SHOWITEMS%)+1       'and highlight the one found
  638.        END IF
  639.  
  640. POPLIST.FOUND.IT.CONT:
  641.        GOSUB POPLIST.FILL                     'display the group of items and highlight one found
  642.  
  643.        OLD=SELECT.%
  644.        RETURN
  645.  
  646. '
  647. '
  648. ' Look for a keyboard key press or a mouse action and return a 'keystroke'
  649. '
  650. POPLIST.GET.PRESS:
  651.        IF BUTTONS%=0 THEN                     'is a mouse supported?
  652.           GOTO POPLIST.GET.INKEY              'no, just look at the keyboard
  653.        END IF
  654.  
  655.        CALL MMGETLOC(MOUSECOL,MOUSEROW)       'get the current mouse cursor scrren location
  656.  
  657.        MOUSEROW=(MOUSEROW\8)+1                'convert row to 80x25 co-ordinates
  658.        MOUSECOL=(MOUSECOL\8)+1                'convert columnto 80x25 co-ordinates
  659.  
  660. '
  661. ' Check if the mouse is still in the window box
  662. '
  663. POPLIST.CHECK.IF.INBOX:
  664. '
  665. ' Is the mouse outside the window frame
  666. '
  667.        IF (MOUSEROW<MENU.TOP.ROW) OR (MOUSEROW>MENU.BOTTOM.ROW) THEN
  668.           GOTO POPLIST.OUTSIDE.BOX
  669.        END IF
  670.  
  671. '
  672. ' Is the mouse in the box or on the window frame
  673. '
  674.        IF (MOUSECOL>=MENU.TOP.LEFT.COL) AND (MOUSECOL<=MENU.BOTTOM.RIGHT.COL) THEN
  675.           GOTO POPLIST.FOUNDIT
  676.        END IF
  677.  
  678.  
  679. '
  680. ' Mouse cursor is outside the window, did user click any buttons
  681. '
  682. POPLIST.OUTSIDE.BOX:
  683.        LFT%=0
  684.        RGT%=0
  685.        CALL MMCLICK(LFT%,RGT%)                'see if left or right button clicked?
  686.        CLICK=LFT%+RGT%
  687.        IF CLICK=0 THEN                        'any button clicked?
  688.            GOTO POPLIST.OUTSIDE.BOX.CONT      'NO
  689.        END IF
  690.  
  691. '
  692. 'If any button clicked outside window then simualte an ESC key press
  693. '
  694.        IF (MOUSECOL<MENU.TOP.LEFT.COL-1) OR (MOUSECOL>MENU.BOTTOM.RIGHT.COL+1) THEN
  695.              KP$=CHR$(27)                      'simulate ESC key press
  696.           RETURN
  697.        END IF
  698.  
  699. '
  700. ' Mouse was clicked on the top or bottom window frame, get the character under
  701. 'the mouse cursor (on the screen)
  702. '
  703.        SCREEN.CHR=SCREEN(MOUSEROW,MOUSECOL)
  704.  
  705.        KP$=CHR$(0)+CHR$(73)                   'assume 'page up' to be simulated
  706.  
  707.        IF MOUSEROW=MENU.TOP.ROW-1 THEN        'mouse on upper window frame?
  708.           IF SHOWITEMS%<>MAXITEMS% THEN       'are we doing POPMENU
  709.              IF SCREEN.CHR=31 THEN            'NO, user click on 'down' arrow
  710.                    KP$=CHR$(0)+CHR$(81)       'YES, simulate 'page down' keystroke
  711.                  RETURN
  712.              ELSEIF SCREEN.CHR=30 THEN        'was mouse cursor on 'up' character
  713.                  RETURN
  714.              ELSE
  715.                  RETURN
  716.              END IF
  717.           END IF
  718.        END IF
  719.  
  720.        KP$=CHR$(0)+CHR$(81)                   'assume 'page down' to be simulated
  721.  
  722.        IF MOUSEROW=MENU.BOTTOM.ROW+1 THEN     'mouse on bottom window frame?
  723.           IF SHOWITEMS%<>MAXITEMS% THEN       'are we doing POPMENU
  724.              IF SCREEN.CHR=30 THEN            'NO, user click on 'up' arrow
  725.                    KP$=CHR$(0)+CHR$(73)       'YES, simulate 'page up' keystroke
  726.                  RETURN
  727.              ELSEIF SCREEN.CHR=31 THEN        'was mouse on 'down' character
  728.                  RETURN
  729.              ELSE
  730.                  RETURN
  731.              END IF
  732.           END IF
  733.        END IF
  734.  
  735.        KP$=CHR$(27)                           'Simualate an ESC keypress
  736.        RETURN
  737.  
  738. '
  739. POPLIST.OUTSIDE.BOX.CONT:
  740.        GOTO POPLIST.GET.INKEY                 'see if a keyboard key pressed
  741.  
  742. '
  743. POPLIST.FOUNDIT:
  744.        SELECT.%=BEGVAL+(MOUSEROW-MENU.TOP.ROW) 'this is the one we want to highlight now
  745.  
  746.        IF SELECT.%<>OLD THEN                   'are we on the same one as is currently highlighted
  747.             LFT%=0
  748.             RGT%=0
  749.             CALL MMCLICK(LFT%,RGT%)            'see if mouse clicked on the current highlighted item
  750.             CLICK=LFT%+RGT%                    'was right or left button clicked?
  751.             IF CLICK THEN                      'a button clicked?
  752.                  GOSUB POPLIST.FILL            'NO, so highlight the newone just selected with the mouse
  753.                  OLD=SELECT.%
  754.              ELSE
  755.  
  756.                  SELECT.%=OLD
  757.                GOTO POPLIST.GET.INKEY
  758.             END IF
  759.        END IF
  760.  
  761.        SELECT.%=OLD
  762.  
  763.        LFT%=0
  764.        RGT%=0
  765.        CALL MMCLICK(LFT%,RGT%)                 'see if mouse clicked on the current highlighted item
  766.        CLICK=LFT%+RGT%                         'was right or left button clicked?
  767.  
  768.        IF CLICK THEN                           'a button clicked?
  769.            CLICK=0
  770.            KP$=CHR$(13)                        'YES, simulate a ENTER key press
  771.          RETURN
  772.        END IF
  773.  
  774. '
  775. POPLIST.GET.INKEY:
  776.        KP$=INKEY$                              'get a keyboard keypress character, if one avail.
  777.  
  778.        IF LEN(KP$)=0 THEN                      'keep looking for a mouse or keyboard action
  779.           GOTO POPLIST.GET.PRESS
  780.        END IF
  781.  
  782.        RETURN
  783.  
  784. '
  785. '
  786. ' The Window upper left frame co-ordinates were defined
  787. '
  788. POPLIST.GETORD:
  789.        QUADRANT$=LTRIM$(QUADRANT$)             'strip off any leading and trailing spaces
  790.        QUADRANT$=RTRIM$(QUADRANT$)
  791.  
  792.        COLON.LOC=INSTR(QUADRANT$,":")          'find where the row/column separator char is loacted
  793.  
  794.        IF COLON.LOC=1 THEN                     'was a row defined
  795.            QUADRANT$="02"+QUADRANT$            'NO, so default to row 02
  796.            COLON.LOC=3
  797.        END IF
  798.  
  799.        ULR%=VAL(LEFT$(QUADRANT$,COLON.LOC-1))  'convert row to a interger. to work with
  800.  
  801.        IF (ULR%<1) OR (ULR%>24) THEN           'is row in valid range of screen co-ordinates
  802.           ULR%=2                               'no, so default to row 02
  803.        END IF
  804.  
  805.        IF COLON.LOC=LEN(QUADRANT$) THEN        'was a column co-ordinate defined
  806.           QUADRANT$=QUADRANT$+"00"             'NO, so default to 00
  807.        END IF
  808.  
  809.        ULC%=VAL(MID$(QUADRANT$,COLON.LOC+1))   'convert column to interger, to work with
  810.  
  811.        IF (ULC%<1) OR (ULC%>80) THEN           'is the column in a valid range
  812.            GOSUB POPLIST.CENTER.ON.THE.LINE    'NO, so center the window on the row
  813.        END IF
  814.  
  815.        QUADRANT.ROW$=STR$(ULR%)                'return the string of the row and column we are working with
  816.        QUADRANT$="0"+RIGHT$(QUADRANT.ROW$,LEN(QUADRANT.ROW$)-1)+":"
  817.        QUADRANT.COL$=STR$(ULC%)
  818.        QUADRANT$=QUADRANT$+"0"+RIGHT$(QUADRANT.COL$,LEN(QUADRANT.COL$)-1)
  819.  
  820.        ULR%=ULR%+1                              'allow for window header frame description
  821.  
  822.        LRR%=ULR%+SHOWITEMS%+1                    'calculate the windows lower right row and column co-ord.
  823.        LRC%=ULC%+WINDLEN-1
  824.        RETURN
  825.  
  826. '
  827. POPLIST.CENTER.ON.THE.LINE:
  828.        TEMP.ULC%=40-(LENGTH.MENU.ITEM/2)         'calculate the center point on the row
  829.        IF (ULC%<2) THEN                          'would window be outside screen?
  830.           TEMP.ULC%=2                            'put it back in scrren and allow for frame (but not shadow)
  831.        END IF
  832.  
  833.        ULC%=TEMP.ULC%                            'this is the upper left column needed to center this window
  834.  
  835.        RETURN
  836. '
  837. '
  838. ' Center the window frame header, within the window.
  839. '
  840. POPLIST.PUTHDR:
  841.        PAD=(WINDLEN/2)-(LEN(HEADER$)/2)-.5
  842.        MID$(TEMPHDR$,PAD+1,LEN(HEADER$))=HEADER$
  843.        HEADER$=TEMPHDR$
  844.        RETURN
  845.  
  846. '
  847. POPLIST.MMCURSORON:
  848.        IF BUTTONS%=0 THEN                     'is a mouse supported?
  849.            RETURN                             'NO
  850.        END IF
  851.  
  852.        IF MOUSE.CURSOR=0 THEN                 'is the mouse off at present?
  853.           CALL MMCURSORON                     'YES, turn it on
  854.           MOUSE.CURSOR=-1
  855.        END IF
  856.  
  857.        RETURN
  858.  
  859. POPLIST.MMCURSOROFF:
  860.        IF BUTTONS%=0 THEN                     'is a mouse supported?
  861.            RETURN                             'NO
  862.        END IF
  863.  
  864.        IF MOUSE.CURSOR=-1 THEN                'is the mouse on at present?
  865.           CALL MMCURSOROFF                    'YES, turn it off
  866.           MOUSE.CURSOR=0
  867.        END IF
  868.  
  869.        RETURN
  870. '
  871. POPLIST.SOUNDOFF:
  872.        SOUND 1000,1
  873.        SOUND 1500,2
  874.        SOUND 500,1
  875.        RETURN
  876.  
  877. '
  878. POPLIST.DONE:
  879.        GOSUB POPLIST.MMCURSOROFF              'turn the mouse off as we leave
  880.  
  881.        TEMP.ITEM$=""                          'free string space
  882.        HEADER$=""
  883.        TEMPHDR$=""
  884.        DAT$=""
  885. END SUB
  886.