home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / BOXMENU.BAS < prev    next >
BASIC Source File  |  1993-03-29  |  11KB  |  296 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  8.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  9.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  10.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  11.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  12.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  13.    DECLARE FUNCTION GetCRT2% ()
  14.    DECLARE FUNCTION GetEGA2% ()
  15.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  16.    DECLARE SUB GetMouseLoc (Row%, Column%)
  17.    DECLARE FUNCTION GetVGA2% ()
  18.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  19.    DECLARE SUB MMButton (LeftB%, RightB%)
  20.    DECLARE SUB MMCursorOff ()
  21.    DECLARE SUB MMCursorOn ()
  22.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  23.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  24.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  25.  
  26. SUB BoxMenu (Mouse%, PickList$(), TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Result%)
  27.  
  28.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  29.    IF Visible% THEN LOCATE , , 0
  30.  
  31.    LastItem% = 0
  32.    Columns% = 0
  33.    t1% = UBOUND(PickList$, 1)
  34.    FOR tmp% = t1% TO 1 STEP -1
  35.       t2% = LEN(PickList$(tmp%))
  36.       IF t2% THEN
  37.          IF LastItem% = 0 THEN LastItem% = tmp%
  38.          IF Columns% < t2% THEN Columns% = t2%
  39.       END IF
  40.    NEXT
  41.    IF LastItem% THEN
  42.       Columns% = Columns% + 2
  43.       IF Columns% > 75 THEN Columns% = 75
  44.    ELSE
  45.       Columns% = 14
  46.    END IF
  47.  
  48.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  49.  
  50.    IF GetCRT2% THEN                         ' use fast display unless CGA
  51.       IF GetEGA2% OR GetVGA2% THEN
  52.          Fast% = -1
  53.       ELSE
  54.          Fast% = 0
  55.       END IF
  56.    ELSE
  57.       Fast% = -1
  58.    END IF
  59.  
  60.    RightCol% = LeftCol% + Columns% - 1      ' set right column
  61.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  62.  
  63.    IF Shade% THEN
  64.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  65.       ' this size works regardless of on which side the shadow is displayed...
  66.    ELSE
  67.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  68.    END IF
  69.    DIM SavedScreen%(Words%)
  70.  
  71.    TopRec% = 1
  72.    HiliteRow% = 1
  73.  
  74.    '--- save the screen
  75.    IF Mouse% THEN MMCursorOff
  76.    DSeg% = VARSEG(SavedScreen%(1))
  77.    DOfs% = VARPTR(SavedScreen%(1))
  78.    IF Shade% THEN
  79.       IF Shade% < -2 THEN
  80.          DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  81.       ELSE
  82.          DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
  83.       END IF
  84.    ELSE
  85.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  86.    END IF
  87.  
  88.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  89.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
  90.    IF Mouse% THEN MMCursorOn
  91.    GOSUB DisplayItems
  92.  
  93.    DO
  94.       '--- get input from appropriate device(s)
  95.       IF LeftButton% THEN Delay18th 1
  96.       DO
  97.          IF Mouse% THEN MMButton LeftButton%, RightButton%
  98.          IF LeftButton% = 0 AND RightButton% = 0 THEN
  99.             BIOSInkey AsciiCode%, ScanCode%
  100.          END IF
  101.       LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
  102.       '--- handle mouse input, if any
  103.       IF Mouse% THEN
  104.          IF RightButton% THEN
  105.             AsciiCode% = 27
  106.          ELSEIF (LastItem% < 1) AND LeftButton% THEN
  107.             AsciiCode% = 27
  108.          ELSEIF LeftButton% THEN
  109.             GetMouseLoc MouseRow%, MouseCol%
  110.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  111.                IF MouseCol% = RightCol% + 1 THEN
  112.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  113.                   IF tmp% = 24 THEN
  114.                      ' convert to ^E (same as up arrow)
  115.                      AsciiCode% = 5
  116.                   ELSEIF tmp% = 25 THEN
  117.                      ' convert to ^X (same as down arrow)
  118.                      AsciiCode% = 24
  119.                   END IF
  120.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  121.                   IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
  122.                      HiLiteRow% = MouseRow% - TopRow% + 1
  123.                      AsciiCode% = 13
  124.                   END IF
  125.                END IF
  126.             END IF
  127.          END IF
  128.       END IF
  129.       '--- handle keyboard input, if any
  130.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  131.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  132.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  133.             SELECT CASE AsciiCode%
  134.                CASE 3                     ' ^QC converts to ^<PgDn>
  135.                   AsciiCode% = 0
  136.                   ScanCode% = 118
  137.                CASE 18                    ' ^QR converts to ^<PgUp>
  138.                   AsciiCode% = 0
  139.                   ScanCode% = 132
  140.                CASE ELSE
  141.                   AsciiCode% = 0
  142.                   ScanCode% = 0
  143.             END SELECT
  144.          END IF
  145.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  146.             ' <HOME>
  147.             IF HiliteRow% > 1 THEN
  148.                HiliteRow% = 1
  149.                GOSUB DisplayItems
  150.             END IF
  151.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  152.             ' <END>
  153.             IF TopRec% + Rows% > LastItem% THEN
  154.                HiliteRow% = LastItem% - TopRec% + 1
  155.             ELSE
  156.                HiliteRow% = Rows%
  157.             END IF
  158.             GOSUB DisplayItems
  159.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  160.             ' <CTRL><PGDN>
  161.             TopRec% = LastItem% - Rows% + 1
  162.             IF TopRec% < 1 THEN TopRec% = 1
  163.             IF TopRec% + Rows% > LastItem% THEN
  164.                HiliteRow% = LastItem% - TopRec% + 1
  165.             ELSE
  166.                HiliteRow% = Rows%
  167.             END IF
  168.             GOSUB DisplayItems
  169.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  170.             ' <CTRL><PGUP>
  171.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  172.                TopRec% = 1
  173.                HiliteRow% = 1
  174.                GOSUB DisplayItems
  175.             END IF
  176.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  177.             ' ^C or PgDn
  178.             IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
  179.                TopRec% = TopRec% + Rows%
  180.             ELSE
  181.                TopRec% = LastItem% - Rows% + 1
  182.                IF TopRec% < 1 THEN TopRec% = 1
  183.             END IF
  184.             IF TopRec% > LastItem% THEN TopRec% = LastItem%
  185.             IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
  186.                HiliteRow% = LastItem% - TopRec% + 1
  187.             END IF
  188.             GOSUB DisplayItems
  189.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  190.             ' ^E or up arrow
  191.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  192.                IF HiliteRow% > 1 THEN
  193.                   HiliteRow% = HiliteRow% - 1
  194.                ELSE
  195.                   TopRec% = TopRec% - 1
  196.                END IF
  197.                GOSUB DisplayItems
  198.             END IF
  199.          ELSEIF AsciiCode% = 13 THEN
  200.             ' <CR>
  201.             IF LastItem% < 1 THEN
  202.                AsciiCode% = 27
  203.                LemmeOuttaHere% = -1
  204.             ELSE
  205.                PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastItem%)
  206.             END IF
  207.          ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
  208.             ' ^X or down arrow
  209.             IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
  210.                HiliteRow% = HiliteRow% + 1
  211.                GOSUB DisplayItems
  212.             ELSE
  213.                IF TopRec% + Rows% - 1 < LastItem% THEN
  214.                   TopRec% = TopRec% + 1
  215.                   GOSUB DisplayItems
  216.                END IF
  217.             END IF
  218.          ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
  219.             ' ^R or PgUp
  220.             IF TopRec% > Rows% THEN
  221.                TopRec% = TopRec% - Rows%
  222.                GOSUB DisplayItems
  223.             ELSE
  224.                IF TopRec% > 1 THEN
  225.                   TopRec% = 1
  226.                   GOSUB DisplayItems
  227.                END IF
  228.             END IF
  229.          ELSEIF AsciiCode% = 27 THEN
  230.             ' <ESC>
  231.             LemmeOuttaHere% = -1
  232.          END IF
  233.       END IF
  234.    LOOP UNTIL PickedOne% OR LemmeOuttaHere%
  235.  
  236.    IF PickedOne% THEN
  237.       Result% = TopRec% + HiLiteRow% - 1
  238.    ELSE
  239.       Result% = 0
  240.    END IF
  241.  
  242.    '--- restore the screen
  243.    IF Mouse% THEN MMCursorOff
  244.    DSeg% = VARSEG(SavedScreen%(1))
  245.    DOfs% = VARPTR(SavedScreen%(1))
  246.    IF Shade% THEN
  247.       IF Shade% < -2 THEN
  248.          DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  249.       ELSE
  250.          DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
  251.       END IF
  252.    ELSE
  253.       DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  254.    END IF
  255.    IF Mouse% THEN MMCursorOn
  256.    IF Visible% THEN LOCATE , , 1
  257.  
  258.    EXIT SUB
  259.  
  260. DisplayItems:
  261.    IF Mouse% THEN MMCursorOff
  262.    IF LastItem% < 1 THEN
  263.       XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
  264.    ELSE
  265.       ' update scroll bar as needed
  266.       IF Rows% < LastItem% THEN
  267.          FOR Row% = TopRow% TO BottomRow%
  268.             XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
  269.          NEXT
  270.          IF TopRec% > 1 AND Rows% > 1 THEN
  271.             XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  272.          END IF
  273.          IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
  274.             XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
  275.          END IF
  276.       END IF
  277.       ' update item list
  278.       FOR Row% = 1 TO Rows%
  279.          tmp% = TopRec% + Row% - 1
  280.          IF tmp% <= LastItem% THEN
  281.             St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
  282.          ELSE
  283.             St$ = SPACE$(Columns%)
  284.          END IF
  285.          IF Row% = HiliteRow% THEN
  286.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
  287.          ELSE
  288.             XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
  289.          END IF
  290.       NEXT
  291.    END IF
  292.    IF Mouse% THEN MMCursorOn
  293.    RETURN
  294.  
  295. END SUB
  296.