Point Programming 1/PPROG1.ISO/basic/baswiz19/examples/wmenupu.bas

BASIC Source File | 1993-01-29 | 5.9 KB | 137 lines

'   +----------------------------------------------------------------------+
'   |                                                                      |
'   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
'   |                                                                      |
'   |                      The BASIC Wizard's Library                      |
'   |                                                                      |
'   +----------------------------------------------------------------------+

   DECLARE SUB WColor (BYVAL Handle%, BYVAL Fore%, BYVAL Back%)
   DECLARE SUB WCursor (BYVAL Handle%, BYVAL CSize%)
   DECLARE SUB WGetColor (BYVAL Handle%, Fore%, Back%)
   DECLARE SUB WGetCursor (BYVAL Handle%, CSize%)
   DECLARE SUB WGetScroll (BYVAL Handle%, AutoScroll%)
   DECLARE SUB WGetSize (BYVAL Handle%, Rows%, Columns%)
   DECLARE SUB WLocate (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
   DECLARE SUB WScroll (BYVAL Handle%, BYVAL AutoScroll%)
   DECLARE SUB WUpdate ()
   DECLARE SUB WView (BYVAL Handle%, BYVAL Row%, BYVAL Column%)
   DECLARE SUB WWriteLn (BYVAL Handle%, St$)

   DEFINT A-Z

FUNCTION WMenuPopUp (Handle, PickList$(), HiFore, HiBack)

' ------ Initialize ---------------------------------------------------------
' Here we save any information about the window which we're going to change,
' so we can restore it when we exit.  The location of the window within the
' virtual screen, the cursor position, and the text of the virtual screen are
' not saved... the window is left in its final state in case we want to pop
' up a sub-menu next to it or something of the sort.

   WGetColor Handle, Fore, Back
   WGetCursor Handle, Cursor
   WGetScroll Handle, AutoScroll
   WGetSize Handle, Rows, Columns

' After saving the relevant parameters, we set the virtual screen to suit our
' needs: move the window to the top left corner of the virtual screen, turn
' off the cursor, and turn off scrolling.  We also initialize some variables.

   Highlight = 1             ' row of the highlight bar
   TopRow = 1                ' top row of the window within the virt. screen
   WView Handle, TopRow, 1
   WScroll Handle, 0
   WCursor Handle, 0
   FirstChoice = LBOUND(PickList$)
   LastChoice = UBOUND(PickList$)

' ------ Main Handler -------------------------------------------------------
' The pick list is written to the virtual screen and displayed.  When a key
' is pressed, appropriate action is taken.  Unless it was an exit key (abort
' or select), we'll come right back and do it all over again.
' ------
' It may seem sloppy to rewrite the entire pick list every time, but it's by
' far the easiest way to handle it.  The virtual windowing system is so fast
' that this inefficiency just doesn't matter, in this particular application
' at least (most of the time is spent waiting for them to press a key).

   DO
      WLocate Handle, 1, 1                     ' write the menu choices
      FOR tmp = FirstChoice TO LastChoice
         St$ = LEFT$(PickList$(tmp) + SPACE$(Columns), Columns)
         WLocate Handle, tmp - FirstChoice + 1, 1
         IF tmp - FirstChoice + 1 = Highlight THEN
            WColor Handle, HiFore, HiBack
            WWriteLn Handle, St$
            WColor Handle, Fore, Back
         ELSE
            WWriteLn Handle, St$
         END IF
      NEXT
      WUpdate
      DO                                       ' wait until we get a key
         ky$ = INKEY$
      LOOP UNTIL LEN(ky$)
      ky = ASC(RIGHT$(ky$, 1))
      IF LEN(ky$) = 1 THEN                     ' process the key
         SELECT CASE ky
            CASE 5: GOSUB LineUp               ' Control E (WordStar move up)
            CASE 9: GOSUB LineDown             ' Tab       (Lotus move forward)
            CASE 24: GOSUB LineDown            ' Control X (WordStar move down)
            CASE 13: Done = -1                 ' Enter     (they've picked one)
            CASE 27: Done = -1: Highlight = 0  ' ESC       (abort menu)
            CASE ELSE
         END SELECT
      ELSE
         SELECT CASE ky
            CASE 72: GOSUB LineUp              ' Up arrow   (keypad move up)
            CASE 15: GOSUB LineUp              ' BackTab    (Lotus move back)
            CASE 80: GOSUB LineDown            ' Down arrow (keypad move down)
            CASE ELSE
         END SELECT
      END IF
   LOOP UNTIL Done                             ' go do it again if need be!
   GOTO Terminate                              ' otherwise, exit

' ------ Move Up a Row ------------------------------------------------------
' If they want to move up a row, we check to see if it's possible.  If so, we
' move the highlighted row up.  We also change the window view if need be.

LineUp:
   IF Highlight > 1 THEN
      Highlight = Highlight - 1
      IF Highlight < TopRow THEN
         TopRow = TopRow - 1
         WView Handle, TopRow, 1
      END IF
   END IF
   RETURN

' ------ Move Down a Row ----------------------------------------------------
' If they want to move down a row, we check to see if it's possible.  If so,
' we move the highlighted row down, changing the window view too, if needed.

LineDown:
   IF Highlight < LastChoice - FirstChoice + 1 THEN
      Highlight = Highlight + 1
      IF Highlight > TopRow + Rows - 1 THEN
         TopRow = TopRow + 1
         WView Handle, TopRow, 1
      END IF
   END IF
   RETURN

' ------ Terminate ----------------------------------------------------------
' They selected an option or aborted the menu, so we're done.  We restore
' some of the window settings that we changed, on the off chance that the
' window might later be used for something other than a menu.  The highlight
' row is returned as the result, which will be 0 if they aborted.

Terminate:
   WScroll Handle, AutoScroll
   WCursor Handle, Cursor
   WMenuPopUp = Highlight

END FUNCTION