home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBCLON20.ZIP / PBC$BAS.ZIP / BARMENUM.BAS < prev    next >
BASIC Source File  |  1992-10-07  |  5KB  |  168 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1992  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB AltKey (ASCIICode%, ScanCode%, Ky$)
  8.    DECLARE SUB CheckKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  9.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  10.    DECLARE SUB GetMouseLoc (Row%, Column%)
  11.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  12.    DECLARE SUB MMCursorOff ()
  13.    DECLARE SUB MMCursorOn ()
  14.    DECLARE SUB MouseBuffer (Bytes%)
  15.    DECLARE SUB MouseRest (St$)
  16.    DECLARE SUB MouseSave (St$)
  17.    DECLARE SUB ReColorArea (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  18.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
  19.  
  20. SUB BarMenuM (PickList$(), Row%, LCol%, RCol%, Attr%, HiAttr%, PromptSt$, Mouse%, ShowCursor%)
  21.  
  22.    L% = LBOUND(PickList$) - 1
  23.  
  24.    Choices% = 0
  25.    FOR tmp% = LBOUND(PickList$) TO UBOUND(PickList$)
  26.       IF LEN(PickList$(tmp%)) THEN
  27.          Choices% = Choices% + 1
  28.       ELSE
  29.          EXIT FOR
  30.       END IF
  31.    NEXT
  32.    IF Choices% = 0 THEN
  33.       Row% = 0
  34.       EXIT SUB
  35.    END IF
  36.  
  37.    DIM Posn%(1 TO Choices%)
  38.  
  39.    GetVidMode BIOSMode%, ScreenWidth%, Page%
  40.  
  41.    IF Row% = 0 THEN Row% = 1
  42.  
  43.    IF LCol% THEN
  44.       LeftCol% = LCol%
  45.    ELSE
  46.       LeftCol% = 1
  47.    END IF
  48.  
  49.    IF RCol% THEN
  50.       RightCol% = RCol%
  51.    ELSE
  52.       RightCol% = ScreenWidth%
  53.    END IF
  54.  
  55.    IF LEN(PromptSt$) THEN
  56.       Prompt$ = PromptSt$
  57.    ELSE
  58.       Prompt$ = " "
  59.    END IF
  60.  
  61.    Place% = 1
  62.  
  63.    BarPlace% = LeftCol% + LEN(Prompt$)
  64.    FOR tmp% = 1 TO Choices%
  65.       Posn%(tmp%) = BarPlace%
  66.       st$ = PickList$(L% + tmp%)
  67.       Bar$ = Bar$ + " " + st$ + " "
  68.       BarPlace% = BarPlace% + LEN(st$) + 2
  69.       ok% = 0
  70.       DO UNTIL ok% OR LEN(st$) = 0
  71.          ch$ = LEFT$(st$, 1)
  72.          ok% = (ch$ > " " AND ch$ < "a" OR ch$ > "z")
  73.          st$ = MID$(st$, 2)
  74.       LOOP
  75.       IF ok% THEN
  76.          KeyList$ = KeyList$ + ch$
  77.       ELSE
  78.          KeyList$ = KeyList$ + UCASE$(LEFT$(PickList$(L% + tmp%), 1))
  79.       END IF
  80.    NEXT
  81.    IF RightCol% < 1 THEN RightCol% = BarPlace%
  82.    IF RightCol% > ScreenWidth% THEN RightCol% = ScreenWidth%
  83.    Bar$ = LEFT$(Prompt$ + Bar$ + SPACE$(ScreenWidth%), RightCol% - LeftCol% + 1)
  84.  
  85.    IF Mouse% THEN
  86.       MouseBuffer Bytes%                                ' save mouse state
  87.       OldMouse$ = SPACE$(Bytes%)
  88.       MouseSave OldMouse$
  89.    END IF
  90.  
  91.    IF Mouse% THEN MMCursorOff
  92.    XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
  93.    RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
  94.    ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%
  95.  
  96.    CheckKey Mouse%, AscCode%, ScanCode%, LeftB%, RightB%  ' clear mouse buttons
  97.  
  98.    DO
  99.       IF Mouse% THEN MMCursorOn
  100.       GetKey Mouse%, AscCode%, ScanCode%, LeftB%, RightB%
  101.       IF LeftB% THEN
  102.          GetMouseLoc R%, C%
  103.          IF R% = Row% THEN
  104.             tmp% = 1
  105.             found% = 0
  106.             DO WHILE tmp% <= Choices% AND NOT found%
  107.                IF C% >= Posn%(tmp%) AND C% <= Posn%(tmp%) + LEN(PickList$(L% + tmp%)) + 1 THEN
  108.                   found% = -1
  109.                ELSE
  110.                   tmp% = tmp% + 1
  111.                END IF
  112.             LOOP
  113.             IF found% THEN
  114.                Place% = tmp%
  115.                AscCode% = 13
  116.                Done% = -1
  117.             END IF
  118.          END IF
  119.       ELSEIF RightB% THEN
  120.          AscCode% = 27
  121.          Done% = -1
  122.       ELSEIF AscCode% = 8 OR AscCode% = 0 AND (ScanCode% = 15 OR ScanCode% = 75) THEN
  123.          ' *** backspace, backtab, left arrow ***
  124.          IF Place% = 1 THEN
  125.             Place% = Choices%
  126.          ELSE
  127.             Place% = Place% - 1
  128.          END IF
  129.       ELSEIF AscCode% = 32 OR AscCode% = 9 OR AscCode% = 0 AND ScanCode% = 77 THEN
  130.          ' *** space, tab, right arrow ***
  131.          IF Place% = Choices% THEN
  132.             Place% = 1
  133.          ELSE
  134.             Place% = Place% + 1
  135.          END IF
  136.       ELSEIF AscCode% = 13 OR AscCode% = 27 THEN
  137.          ' *** <CR>, <ESC> ***
  138.          Done% = -1
  139.       ELSE
  140.          ' *** anything else... check to see if it's a menu selection ***
  141.          IF AscCode% > 32 THEN
  142.             ch$ = UCASE$(CHR$(AscCode%))
  143.          ELSE
  144.             AltKey AscCode%, ScanCode%, ch$
  145.          END IF
  146.          IF LEN(ch$) THEN
  147.             tmp% = INSTR(KeyList$, ch$)
  148.             IF tmp% THEN
  149.                Place% = tmp%
  150.                Done% = -1
  151.             END IF
  152.          END IF
  153.       END IF
  154.       IF Mouse% THEN MMCursorOff
  155.       XQPrint Bar$, Row%, LeftCol%, Attr%, Page%, Fast%
  156.       RightCol% = Posn%(Place%) + LEN(PickList$(L% + Place%)) + 1
  157.       ReColorArea Row%, Posn%(Place%), Row%, RightCol%, HiAttr%, Page%, Fast%
  158.    LOOP UNTIL Done%
  159.  
  160.    IF AscCode% = 27 THEN
  161.       Row% = 0
  162.    ELSE
  163.       Row% = Place%
  164.    END IF
  165.  
  166.    IF Mouse% THEN MouseRest OldMouse$                   ' restore mouse state
  167. END SUB
  168.