home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / quicksub / mnulin.sub < prev    next >
Encoding:
Text File  |  1986-06-12  |  2.8 KB  |  106 lines
  1. ' MNULIN.SUB -- MSDOS QuickBASIC Color line menu subroutine
  2. '           by David L. Poskie   Madison, WI 
  3.  
  4. '| Reads up to 11 one-line menus, up to 9 selections per menu from DATA lines
  5. '|  located in the calling program. 
  6. '| Load menus in MENU$(n,n) by GOSUB LOAD.MNU , returns MAX.MNU = # of menus.
  7. '| LOCATE cursor before calling menu, then call a menu by:
  8. '|   setting MNU = (0 to 10) : GOSUB MNULIN -- evaluate K.CODE on RETURN.
  9. '| Quit will always return K.CODE = -21. I use this number because <ESC> also
  10. '|   returns -21.  Thus, you can bail out of a menu with <ESC>. No other
  11. '|   evaluation is made -- you will get any out of bounds numbers and must
  12. '|   check for these in the main program.
  13. '|
  14. '| Saves foreground & background colors, restoring them after input.
  15. '|
  16. '| Vars: MENU$(),MNU(),K.CODE,MAX.MNU,MNU,NUM.MNU,NUM.SEL(),SEL,FG,BG,BLANK.
  17.  
  18.     ' Subroutine to read DATA into MENU$(MNU , SEL),
  19.     '   loading all the menus and prompts.
  20. LOAD.MNU:
  21.  
  22.     RESTORE MENU.DAT            ' In case the pointer is 
  23.     FOR MNU = 0 TO 10            '   somewhere else
  24.         FOR SEL = 0 TO 10
  25.         READ MENU$(MNU , SEL)
  26.  
  27.         ' Look for end of ONE menu symbol
  28.         IF MENU$(MNU , SEL) = "*"                _
  29.            THEN NUM.SEL(MNU) = SEL - 1 :            _
  30.             GOTO LOAD.MNU.LOOP 
  31.         ' NUM.SEL(MNU) holds number of selections
  32.  
  33.         ' Look for end of ALL menus symbol
  34.         IF MENU$(MNU , SEL) = "$"                _
  35.            THEN NUM.MNU = MNU - 1 :                _
  36.         GO TO LOAD.MNU.XIT
  37.  
  38.         NEXT SEL
  39.  
  40.     ' One Menu is read
  41. LOAD.MNU.LOOP:
  42.  
  43.     NEXT MNU
  44.  
  45.     ' All Menus are read
  46. LOAD.MNU.XIT:
  47.  
  48.     MAX.MNU = MNU - 1        ' Maximum number of menus
  49. RETURN
  50.     '____________________END OF LOAD.MNU SUBROUTINE______________________
  51.  
  52.     'Subroutine to print the menu line and get a response
  53. MNULIN:
  54.  
  55.     ' Read foreground color
  56.     FG = ((SCREEN (1 , 1 , 1)) MOD 16)
  57.  
  58.     ' Read background color
  59.     BG = (((SCREEN (1 , 1 , 1)) - FG) / 16) MOD 128
  60.  
  61.     ' Set blank space between selections
  62.     BLANK = 0
  63.  
  64.     FOR I = 0 TO NUM.SEL(MNU)
  65.         BLANK = BLANK + LEN(STR$(I)) + LEN(MENU$(MNU , I)) + 2
  66.     NEXT I
  67.  
  68.     BLANK = INT((80 - BLANK) / NUM.SEL(MNU) - 1)
  69.  
  70.     ' Case of a negative number
  71.     IF BLANK < 0                            _
  72.        THEN BLANK = 0
  73.  
  74.     ' Case of protecting BLANK = 1
  75.     IF BLANK > 1                             _
  76.        THEN BLANK = INT(BLANK / 2)
  77.  
  78.     ' Print menu line
  79.     COLOR 0 , 7
  80.  
  81.     FOR I = 1 TO NUM.SEL(MNU)
  82.         PRINT SPC(BLANK); STR$(I); SPC(BLANK); MENU$(MNU,I); " █";
  83.     NEXT I
  84.  
  85.     ' Print prompt
  86.     COLOR 28 , 0
  87.     PRINT " « ";
  88.     COLOR 12
  89.     PRINT MENU$(MNU , 0);
  90.  
  91.     GOSUB GETKEY.CLEAR
  92.  
  93.     K.CODE = K.CODE - 48            ' Adjust to track with number
  94.  
  95.     ' Set Quit Command to -21
  96.     IF K.CODE = NUM.SEL(MNU)                    _
  97.        THEN K.CODE = -21            ' Allows bailout on <ESC>
  98.  
  99.     ' Restore colors & go
  100.     COLOR FG , BG
  101.  
  102. RETURN
  103.     '____________________END OF MNULIN SUBROUTINE______________________
  104.  
  105. '>>>>> Physical EOF MNULIN.SUB
  106.