Vertical Menu 1 Of 2

 BBS: Inland Empire Archive
Date: 06-16-92 (13:20)             Number: 543
From: BRUCE GROEN                  Refer#: NONE
  To: MARK BUTLER                   Recvd: NO  
Subj: Vertical Menu 1 Of 2           Conf: (2) Quik_Bas

*MB>  Are you talking about Christy Gremmel's routines? I scrapped my own   *
*MB>  home brewed windowing routines in favor of hers as soon as I saw      *
*MB>  them! I liked the way they imploded as well as exploded. You bet I'd  *
*MB>  like to see your routines! :-))                                       *
*****************************************************************************
Below is my vertical menu routine.  It was already somewhat commented so I
figured I would send it first.  I have to variables that I have common
shared that you will need for this routine.  Attr and IAttr.  Attr is the
attribute for normal text and IAttr is the attribute for the selected option.
I popup a window first and then call this routine and then when it returns,
shutup the window and presto.  I am sure this is not that different from
other vertical menus you have seen but it is the one that I use.  If anyone
sees something that I can improve on please let me know.  I will get the
scrolling list and others to you soon.

SUB ScrollMenu (Menu$(), Entries, TopRow, LeftCol, Return$, SkipLine, RC)
'+
---+
'| Creates a Menu with a scrolling hilight bar used to make selection. |
'| Menu$                                                               |
'|         Variable Lenght String Array holding the menu selections.   |
'| Entries                                                             |
'|         % holding the number of menu selection.                     |
'| TopRow                                                              |
'|         % holding the row on which to print the first selection.    |
'| LeftCol                                                             |
'|         % holding the column on which to start the first selection. |
'| Return$                                                             |
'|         $ with all keys that will return from the menu in the order |
'|         they represent.  For Example:                               |
'|         File  \                                                     |
'|         Edit   > Would have a Return$ of "FEV"                      |
'|         View  /                                                     |
'| SkipLine                                                            |
':         % flag. If >0 then a blank line will be put between menu    |
'|         selections. If 0 then no blank line will be printed.        |
'| RC                                                                  |
'|         % return code with the number representing the entry in the |
'|         array that was selected.                                    |
'+
---+

'Find Longest entry
FOR TempLoop = 1 TO Entries
IF LEN(Menu$(TempLoop)) > Length THEN Length = LEN(Menu$(TempLoop))
NEXT

'Prepare to skip a line between entries
IF SkipLine THEN
   NextRow = 2
ELSE NextRow = 1
END IF

Row = TopRow

'Display menu entries
FOR TempLoop = 1 TO Entries
   FastPrint Row, LeftCol, Menu$(TempLoop), Attr
   Row = Row + NextRow
NEXT

'Hilight First Entry
CursorEntry = 1
GOSUB PrintBar

WaitForInput:
DO: Key$ = INKEY$: LOOP UNTIL LEN(Key$)
IF LEN(Key$) > 1 THEN
   GOTO Extended
ELSE GOTO Normal
END IF

Extended:
SELECT CASE ASC(RIGHT$(Key$, 1))
   CASE 71, 73 'Home Key & PageUp
          GOSUB EraseBar
          CursorEntry = 1
          GOSUB PrintBar
   CASE 72  'Up Arrow
          GOSUB EraseBar
          CursorEntry = CursorEntry - 1
          IF CursorEntry = 0 THEN CursorEntry = Entries
          GOSUB PrintBar
   CASE 79, 81 'End Key and PageDown
          GOSUB EraseBar
          CursorEntry = Entries
          GOSUB PrintBar
   CASE 80  'Down Arrow
          GOSUB EraseBar
          CursorEntry = CursorEntry + 1
          IF CursorEntry > Entries THEN CursorEntry = 1
          GOSUB PrintBar
END SELECT
GOTO WaitForInput
Continued Next message.
* MegaMail 2.1* #0:Psst! Your .zip file is open.
---
 * Origin: PCConsultingAgency USR DS - Tuc AZ - (602)790-6230 (1:300/21)