DP Tool Club 13/CD_ASCQ_13_0494.iso/maj/419/boxmenu.bas

BASIC Source File | 1994-03-13 | 11KB | 296 lines

'   +----------------------------------------------------------------------+
'   |                                                                      |
'   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
'   |                                                                      |
'   +----------------------------------------------------------------------+

   DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
   DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
   DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
   DECLARE SUB Delay18th (BYVAL WaitTime%)
   DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
   DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
   DECLARE FUNCTION GetCRT2% ()
   DECLARE FUNCTION GetEGA2% ()
   DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
   DECLARE SUB GetMouseLoc (Row%, Column%)
   DECLARE FUNCTION GetVGA2% ()
   DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
   DECLARE SUB MMButton (LeftB%, RightB%)
   DECLARE SUB MMCursorOff ()
   DECLARE SUB MMCursorOn ()
   DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
   DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
   DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)

SUB BoxMenu (Mouse%, PickList$(), TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Result%)

   CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
   IF Visible% THEN LOCATE , , 0

   LastItem% = 0
   Columns% = 0
   t1% = UBOUND(PickList$, 1)
   FOR tmp% = t1% TO 1 STEP -1
      t2% = LEN(PickList$(tmp%))
      IF t2% THEN
         IF LastItem% = 0 THEN LastItem% = tmp%
         IF Columns% < t2% THEN Columns% = t2%
      END IF
   NEXT
   IF LastItem% THEN
      Columns% = Columns% + 2
      IF Columns% > 75 THEN Columns% = 75
   ELSE
      Columns% = 14
   END IF

   GetVidMode VMode%, Cols%, Page%          ' use active display page

   IF GetCRT2% THEN                         ' use fast display unless CGA
      IF GetEGA2% OR GetVGA2% THEN
         Fast% = -1
      ELSE
         Fast% = 0
      END IF
   ELSE
      Fast% = -1
   END IF

   RightCol% = LeftCol% + Columns% - 1      ' set right column
   Rows% = BottomRow% - TopRow% + 1         ' and number of rows

   IF Shade% THEN
      CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
      ' this size works regardless of on which side the shadow is displayed...
   ELSE
      CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
   END IF
   DIM SavedScreen%(Words%)

   TopRec% = 1
   HiliteRow% = 1

   '--- save the screen
   IF Mouse% THEN MMCursorOff
   DSeg% = VARSEG(SavedScreen%(1))
   DOfs% = VARPTR(SavedScreen%(1))
   IF Shade% THEN
      IF Shade% < -2 THEN
         DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
      ELSE
         DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
      END IF
   ELSE
      DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
   END IF

   UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
   WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
   IF Mouse% THEN MMCursorOn
   GOSUB DisplayItems

   DO
      '--- get input from appropriate device(s)
      IF LeftButton% THEN Delay18th 1
      DO
         IF Mouse% THEN MMButton LeftButton%, RightButton%
         IF LeftButton% = 0 AND RightButton% = 0 THEN
            BIOSInkey AsciiCode%, ScanCode%
         END IF
      LOOP UNTIL LeftButton% OR RightButton% OR AsciiCode% OR ScanCode%
      '--- handle mouse input, if any
      IF Mouse% THEN
         IF RightButton% THEN
            AsciiCode% = 27
         ELSEIF (LastItem% < 1) AND LeftButton% THEN
            AsciiCode% = 27
         ELSEIF LeftButton% THEN
            GetMouseLoc MouseRow%, MouseCol%
            IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
               IF MouseCol% = RightCol% + 1 THEN
                  tmp% = SCREEN(MouseRow%, MouseCol%)
                  IF tmp% = 24 THEN
                     ' convert to ^E (same as up arrow)
                     AsciiCode% = 5
                  ELSEIF tmp% = 25 THEN
                     ' convert to ^X (same as down arrow)
                     AsciiCode% = 24
                  END IF
               ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
                  IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
                     HiLiteRow% = MouseRow% - TopRow% + 1
                     AsciiCode% = 13
                  END IF
               END IF
            END IF
         END IF
      END IF
      '--- handle keyboard input, if any
      IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
         IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
            GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
            SELECT CASE AsciiCode%
               CASE 3                     ' ^QC converts to ^<PgDn>
                  AsciiCode% = 0
                  ScanCode% = 118
               CASE 18                    ' ^QR converts to ^<PgUp>
                  AsciiCode% = 0
                  ScanCode% = 132
               CASE ELSE
                  AsciiCode% = 0
                  ScanCode% = 0
            END SELECT
         END IF
         IF AsciiCode% = 0 AND ScanCode% = 71 THEN
            ' <HOME>
            IF HiliteRow% > 1 THEN
               HiliteRow% = 1
               GOSUB DisplayItems
            END IF
         ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
            ' <END>
            IF TopRec% + Rows% > LastItem% THEN
               HiliteRow% = LastItem% - TopRec% + 1
            ELSE
               HiliteRow% = Rows%
            END IF
            GOSUB DisplayItems
         ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
            ' <CTRL><PGDN>
            TopRec% = LastItem% - Rows% + 1
            IF TopRec% < 1 THEN TopRec% = 1
            IF TopRec% + Rows% > LastItem% THEN
               HiliteRow% = LastItem% - TopRec% + 1
            ELSE
               HiliteRow% = Rows%
            END IF
            GOSUB DisplayItems
         ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
            ' <CTRL><PGUP>
            IF TopRec% > 1 OR HiliteRow% > 1 THEN
               TopRec% = 1
               HiliteRow% = 1
               GOSUB DisplayItems
            END IF
         ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
            ' ^C or PgDn
            IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
               TopRec% = TopRec% + Rows%
            ELSE
               TopRec% = LastItem% - Rows% + 1
               IF TopRec% < 1 THEN TopRec% = 1
            END IF
            IF TopRec% > LastItem% THEN TopRec% = LastItem%
            IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
               HiliteRow% = LastItem% - TopRec% + 1
            END IF
            GOSUB DisplayItems
         ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
            ' ^E or up arrow
            IF HiliteRow% > 1 OR TopRec% > 1 THEN
               IF HiliteRow% > 1 THEN
                  HiliteRow% = HiliteRow% - 1
               ELSE
                  TopRec% = TopRec% - 1
               END IF
               GOSUB DisplayItems
            END IF
         ELSEIF AsciiCode% = 13 THEN
            ' <CR>
            IF LastItem% < 1 THEN
               AsciiCode% = 27
               LemmeOuttaHere% = -1
            ELSE
               PickedOne% = (TopRec% + HiLiteRow% - 1 <= LastItem%)
            END IF
         ELSEIF AsciiCode% = 24 OR AsciiCode% = 0 AND ScanCode% = 80 THEN
            ' ^X or down arrow
            IF HiliteRow% < Rows% AND TopRec% + HiliteRow% - 1 < LastItem% THEN
               HiliteRow% = HiliteRow% + 1
               GOSUB DisplayItems
            ELSE
               IF TopRec% + Rows% - 1 < LastItem% THEN
                  TopRec% = TopRec% + 1
                  GOSUB DisplayItems
               END IF
            END IF
         ELSEIF AsciiCode% = 18 OR AsciiCode% = 0 AND ScanCode% = 73 THEN
            ' ^R or PgUp
            IF TopRec% > Rows% THEN
               TopRec% = TopRec% - Rows%
               GOSUB DisplayItems
            ELSE
               IF TopRec% > 1 THEN
                  TopRec% = 1
                  GOSUB DisplayItems
               END IF
            END IF
         ELSEIF AsciiCode% = 27 THEN
            ' <ESC>
            LemmeOuttaHere% = -1
         END IF
      END IF
   LOOP UNTIL PickedOne% OR LemmeOuttaHere%

   IF PickedOne% THEN
      Result% = TopRec% + HiLiteRow% - 1
   ELSE
      Result% = 0
   END IF

   '--- restore the screen
   IF Mouse% THEN MMCursorOff
   DSeg% = VARSEG(SavedScreen%(1))
   DOfs% = VARPTR(SavedScreen%(1))
   IF Shade% THEN
      IF Shade% < -2 THEN
         DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
      ELSE
         DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 3, BottomRow% + 2, RightCol% + 1, Page%, Fast%
      END IF
   ELSE
      DPutScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
   END IF
   IF Mouse% THEN MMCursorOn
   IF Visible% THEN LOCATE , , 1

   EXIT SUB

DisplayItems:
   IF Mouse% THEN MMCursorOff
   IF LastItem% < 1 THEN
      XQPrint "...no items...", TopRow%, LeftCol%, HiliteAttr%, Page%, Fast%
   ELSE
      ' update scroll bar as needed
      IF Rows% < LastItem% THEN
         FOR Row% = TopRow% TO BottomRow%
            XQPrint CHR$(178), Row%, RightCol% + 1, FrameAttr%, Page%, Fast%
         NEXT
         IF TopRec% > 1 AND Rows% > 1 THEN
            XQPrint CHR$(24), TopRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
         END IF
         IF TopRec% + Rows% - 1 < LastItem% AND Rows% > 0 THEN
            XQPrint CHR$(25), BottomRow%, RightCol% + 1, FrameAttr%, Page%, Fast%
         END IF
      END IF
      ' update item list
      FOR Row% = 1 TO Rows%
         tmp% = TopRec% + Row% - 1
         IF tmp% <= LastItem% THEN
            St$ = LEFT$(" " + LEFT$(PickList$(tmp%), Columns% - 2) + SPACE$(Columns%), Columns%)
         ELSE
            St$ = SPACE$(Columns%)
         END IF
         IF Row% = HiliteRow% THEN
            XQPrint St$, TopRow% + Row% - 1, LeftCol%, HiliteAttr%, Page%, Fast%
         ELSE
            XQPrint St$, TopRow% + Row% - 1, LeftCol%, ItemListAttr%, Page%, Fast%
         END IF
      NEXT
   END IF
   IF Mouse% THEN MMCursorOn
   RETURN

END SUB