home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / vrac / menusys.zip / MENUSYS.BAS < prev    next >
BASIC Source File  |  1994-08-07  |  63KB  |  1,413 lines
  1. DEFINT A-Z
  2. DECLARE SUB BlkEdit (Txt$(), LCol, RCol, SRow, ERow, KeyCode)
  3. DECLARE SUB DialogBox (Ddflts$, Dsin$, Dsout$, SelKey, DBCode)
  4. DECLARE SUB MainCalc ()
  5. DECLARE SUB SetUpPgm ()
  6. DECLARE SUB ScrnCopy (Src, Dst)
  7. DECLARE SUB BoxDisplay (Nitm, Nstrt, Txt$(), Ctrl, SDLin, ColCod$, Shdw, SelKey)
  8. DECLARE SUB KeyPress (KeyCode)
  9. DECLARE SUB AKMnuRead (MnuCtrl(), MnuItm1$(), MnuItm2$())
  10. DECLARE SUB AKMnuSet (MnuCtrl(), MnuItm1$(), MnuItm2$())
  11. DECLARE SUB AKMnuCtrl (KeyCode, MnuCtrl(), MnuItm1$(), MnuItm2$(), SelKey)
  12. DECLARE SUB BoxDraw (LCol, RCol, SRow, ERow, BFil, Brdr, FGrnd, BGrnd, Shdw)
  13. DECLARE SUB CenterLin (Row, LCol, RCol, Text$)
  14. DECLARE SUB StrngBar (Row, Text$)
  15.  
  16. '$DYNAMIC                                        'Not needed, but common in pgms
  17.  
  18. 'Example pull-down menu system set up in dummy program structure to demonstate use.
  19. 'There is a typical horizontal key word menu across top with highlighted letters.
  20. 'Alt-highlight key calls a vertical box of menu items.
  21. 'F10 + letter as in CUA compliant menus also selects vertical menu box.
  22. 'Select desired menu item via bounce (highlite) bar or indicated highlite letter.
  23. 'In general <Home>, PgUp, Ctrl-U(p), <End>, arrow keys, <space>, etc. control bounce bar.
  24. 'Program control is passed to menu items based on a convenient numerical code in MainCalc.
  25. 'Can be set up for optional Lotus-style "/" + highlight letter activation of menu.
  26. 'The entire menu system is set up by use of DATA statements as shown below.
  27. 'All but routines MainCalc and SetUpPgm are designed to be used as is in your programs.
  28. 'The AKMnu routines go together and require the Box routines, ScrnCopy, and KeyPress
  29. 'Modify as you need for your programs.  Polling mouse buttons during KeyPress and using
  30. '  menu item row/column arrays to translate mouse cursor position into item selection
  31. '  can be done as a QB programming challenge, if you are rodent inclined.
  32.  
  33. '        Brian Dinsmoor   76675,1606
  34.  
  35. TYPE PgmColors            '  Text SCREEN color variables used to display menu system
  36.         fg AS INTEGER     'Foregrnd
  37.         bg AS INTEGER     'Backgrnd
  38.         bt AS INTEGER     'Border/Title
  39.         wf AS INTEGER     'Window/Msg Box display foregrnd
  40.         wb AS INTEGER     'Window/Msg Box display backgrnd
  41.         mf AS INTEGER     'Menu foregrnd    >   key
  42.         mb AS INTEGER     'Menu backgrnd    >   menu
  43.         hk AS INTEGER     'HiLite key       >   colors
  44. END TYPE
  45. TYPE SystmData
  46.         vid AS INTEGER    'Type of video adapter by integer code
  47. END TYPE
  48.  
  49. COMMON SHARED pc AS PgmColors, Sdata AS SystmData
  50.  
  51. CALL SetUpPgm                          'Begin execution with setup routine
  52.  
  53. 'BELOW IS DATA ARRAY OF INPUT FOR MENU SYSTEM.  INCLUDE IN MAIN MODULE.
  54. ' Note where " " is used to be sure the BASIC interpreter properly defines variables.
  55. MainMenu1:
  56. DATA 2,6,5,9,FEVSR*,File,Edit,View,Search,Run,"                                 F1 = Help"
  57. DATA 9,NOMS-LU-A,New,Open,Merge,Save,-,Load,Unload,-,Append
  58. DATA 6,UTCP-B,Undo,CuT,Copy,Paste,-,Block
  59. DATA 7,SNP-I-O,Subs,Next,SPlit,-,Include,-,Options ...
  60. DATA 4,FSRC,Find,Selected,Repeat,Change
  61. DATA 6,SRCM-K,Start,Restart,Continue,Modify ...,-,MaKe
  62.  
  63. MainDialog1:                                     'First Dialog Box
  64. DATA < View Options >,10
  65. DATA 1,S,Search Directory,20
  66. DATA 2,V,Auto View Files,6,WK1/WK2/WQ1/DBF/DIF/SLK
  67. DATA 6," "
  68. DATA 3,D,"Display Window:",3,Primary/Vert Splt/Hor Splt
  69. DATA 4,y,Synch Scroll
  70. DATA 4,A,Auto Save
  71. DATA 4,H,Auto Highlight
  72. DATA 6," "
  73. DATA 5,UFQ,3,Update/DeFault/Quit
  74. DATA 7,"C:\DUMMY\*.DOC/SLK/3/1/0/0/0"
  75.  
  76. MainDialog2:                                     'Second Dialog Box
  77. DATA , 8
  78. DATA 6,"Modem Default ... "
  79. DATA 2,S,Speed,7,300/1200/2400/4800/9600/14400/19200
  80. DATA 3,D,"Data Bits:",2,7/8
  81. DATA 3,P,"Parity:",3,Odd/Even/None
  82. DATA 3,B,"Stop Bits:",3,0/1/2
  83. DATA 2,T,Terminal,4,ANSI/TTY/VT52/VT100
  84. DATA 5,C,1,Connect
  85. DATA 7,"2400/1/2/2/TTY/0"
  86.  
  87. '              |
  88. ' Intro screens for program
  89. '              |
  90. ' Have arrived at program section with menu system
  91. '              |
  92.                                                 
  93. CALL MainCalc
  94.              
  95. '              |
  96. ' Closing of program (update defaults, erase temp files, etc.)
  97. '              |
  98. EndPgm:
  99.     COLOR 7, 0                             'Reset and exit
  100.     CLS
  101.     END
  102.  
  103. REM $STATIC
  104. SUB AKMnuCtrl (KeyCode, MnuCtrl(), MnuItm1$(), MnuItm2$(), SelKey) STATIC
  105.  
  106. 'Vertical Window Menu generator with highlight key option for selections.
  107. 'Alt-Alpha key or F10(+ highlight letter for CUA standard) selections trapped to this routine.
  108. 'Can trap "/" for Lotus style menu system as well.  Can modify AKMnu routines to display
  109. ' stacked horizontal menus as in Lotus 123.
  110. 'Calls BoxDraw for specified horizontal category and displays subordinate Items in box.
  111. 'Cursor keys control highlight bar and <CR> or highlight letter selects item.
  112. '  KeyCode = alt-key menu category selected on input.  Returns as
  113. '      horizontal number category or 0 if error.
  114. '  MnuCtrl, MnuItm$ arrays  - see AKMnuRead subprogram for definitions.
  115. '  SelKey = vertical item number selected for a selected horizontal category("cat").
  116. '           Can be:  0 for selected KeyCode item with no vertical menu
  117. '                   -1 for no valid trapped highlite key
  118. '                   -2 for <Esc> without selection
  119. 'Assumes use of active screen page 0 and stores screens in pages 1, 2.
  120. 'Uses pc.mf, .mb, .hk menu colors.
  121. 'Requires use of ScrnCopy, KeyPress, BoxDraw
  122.  
  123. SELECT CASE KeyCode                              'Extract letter from alt key press
  124.         CASE -25 TO -16
  125.                 letter$ = MID$("POIUYTREWQ", KeyCode + 26, 1)
  126.         CASE -38 TO -30
  127.                 letter$ = MID$("LKJHGFDSA", KeyCode + 39, 1)
  128.         CASE -50 TO -44
  129.                 letter$ = MID$("MNBVCXZ", KeyCode + 51, 1)
  130.         CASE IS = -68                            'F10 key trap for CUA menu.  Can trap 47 ("/") for Lotus style
  131.                 CALL KeyPress(KeyCode)           'Modify here if F10 or / opens first category upon <CR>
  132.                 IF KeyCode < 65 OR KeyCode > 122 THEN   'Must follow with letter
  133.                     letter$ = " "
  134.                 ELSE
  135.                     letter$ = UCASE$(CHR$(KeyCode))
  136.                 END IF
  137.         CASE ELSE
  138.                 KeyCode = 0: SelKey = 0: EXIT SUB  'Return if error
  139. END SELECT
  140. cat = INSTR(MnuItm1$(1), letter$)                'Find in highlight string
  141. IF cat = 0 THEN
  142.         KeyCode = 0: SelKey = -1: EXIT SUB
  143. END IF
  144. IF cat > MnuCtrl(3) THEN
  145.         KeyCode = cat: SelKey = 0: EXIT SUB
  146. END IF
  147.  
  148. AKMCLoop1:
  149. nv = MnuCtrl(MnuCtrl(2) + 3 + cat)               'Extract location and menu parameters
  150. Row = MnuCtrl(1)
  151. col = MnuCtrl(cat + 3) - 1
  152. hkver$ = MnuItm1$(MnuCtrl(2) + 1 + cat)
  153. CALL ScrnCopy(0, 1)                              'Save current screen
  154. LOCATE Row, col, 0                               'Highlight horizontal item
  155. COLOR pc.mb, pc.mf
  156. PRINT " "; MnuItm1$(cat + 1); " ";
  157.  
  158. lmax = 0: SelKey = 1                             'Start with first item
  159. FOR i = 1 TO nv                                  'Find longest item to set width
  160.         a = LEN(MnuItm2$(cat, i))
  161.         IF a > lmax THEN lmax = a
  162. NEXT i
  163. lmax = lmax + 2                                  'Draw filled box
  164. CALL BoxDraw(col, col + lmax + 1, Row + 1, Row + nv + 2, 1, 1, pc.mf, pc.mb, 1)
  165. Row = Row + 1: col = col + 1                     'Relocate for menu items
  166. FOR i = 1 TO nv                                  'Fill in Items 1 thru n
  167.         LOCATE Row + i, col
  168.         IF MnuItm2$(cat, i) = "-" THEN           'If in string, print group divider
  169.                 PRINT STRING$(lmax, 196);
  170.         ELSE
  171.                 PRINT " " + MnuItm2$(cat, i);
  172.                 a$ = MID$(hkver$, i, 1)          'Find and print highlight letter
  173.                 b = INSTR(MnuItm2$(cat, i), a$)
  174.                 IF b > 0 THEN
  175.                         COLOR pc.hk
  176.                         LOCATE , col + b
  177.                         PRINT a$;
  178.                         COLOR pc.mf
  179.                 END IF
  180.         END IF
  181. NEXT i
  182. CALL ScrnCopy(0, 2)                              'Save screen with highlighted menu item
  183.  
  184. AKMCLoop2:                                       'Set up loop for selecting menu items
  185. COLOR pc.mb, pc.mf                               'Highlight SelKey item
  186. LOCATE Row + SelKey, col
  187. PRINT " "; MnuItm2$(cat, SelKey); TAB(col + lmax);
  188. a$ = MID$(hkver$, SelKey, 1)                     'Need highlight letter in Item
  189. b = INSTR(MnuItm2$(cat, SelKey), a$)
  190. IF b > 0 THEN
  191.         COLOR pc.hk
  192.         LOCATE , col + b
  193.         PRINT a$;
  194. END IF
  195.  
  196. AKMCLoop3:                                       'Set up loop for bad key presses
  197. CALL KeyPress(KeyCode)
  198. SELECT CASE KeyCode                              'Process key stroke code
  199.         CASE IS = 27                             'Esc
  200.                 KeyCode = 0: SelKey = -2
  201.                 COLOR pc.fg, pc.bg: CALL ScrnCopy(1, 0)
  202.                 EXIT SUB
  203.         CASE IS = 13
  204.                 KeyCode = cat                    'Return
  205.                 COLOR pc.fg, pc.bg: CALL ScrnCopy(1, 0)
  206.                 EXIT SUB
  207.         CASE IS = -71                            'Home
  208.                 SelKey = 1
  209.         CASE IS = -79                            'End
  210.                 SelKey = nv
  211.         CASE IS = -72, -22                       'Up Arrow, Alt-U
  212.                 SelKey = SelKey - 1
  213.                 IF SelKey = 0 THEN SelKey = nv
  214.                 IF MID$(MnuItm2$(cat, SelKey), 1, 1) = "-" THEN SelKey = SelKey - 1
  215.         CASE IS = -80, -32, 32                   'Down Arrow, Alt-D, space
  216.                 SelKey = SelKey + 1
  217.                 IF SelKey > nv THEN SelKey = 1
  218.                 IF MID$(MnuItm2$(cat, SelKey), 1, 1) = "-" THEN SelKey = SelKey + 1
  219.         CASE IS = -75, -38                       'Left Arrow, Alt-L
  220.                 cat = cat - 1
  221.                 IF cat < 1 THEN cat = MnuCtrl(3)
  222.                 CALL ScrnCopy(1, 0)
  223.                 GOTO AKMCLoop1:
  224.         CASE IS = -77, -19                       'Right Arrow
  225.                 cat = cat + 1
  226.                 IF cat > MnuCtrl(3) THEN cat = 1
  227.                 CALL ScrnCopy(1, 0)
  228.                 GOTO AKMCLoop1:
  229.         CASE 65 TO 90, 97 TO 122                 'If pressed highlight letter, exit
  230.                 FOR i = 1 TO nv
  231.                         IF UCASE$(MID$(hkver$, i, 1)) = UCASE$(CHR$(KeyCode)) THEN
  232.                                 KeyCode = cat: SelKey = i
  233.                                 COLOR pc.fg, pc.bg: CALL ScrnCopy(1, 0)
  234.                                 EXIT SUB
  235.                         END IF
  236.                 NEXT i                           'Note no-action key presses
  237.                 GOTO AKMCLoop3:
  238.         CASE ELSE
  239.                 GOTO AKMCLoop3:
  240. END SELECT
  241. CALL ScrnCopy(2, 0)
  242. GOTO AKMCLoop2:
  243.  
  244. END SUB
  245.  
  246. SUB AKMnuRead (MnuCtrl(), MnuItm1$(), MnuItm2$()) STATIC
  247.  
  248. 'Reads setup for horizontal Alt-Key (or F10+letter) Menu with pull-down vertical menus
  249. ' under some or all of the horizontal items.   Will not work without at least one vertical menu item.
  250. 'Can modify to trap "/" for Lotus style stacked horizontal menus
  251. 'Use DATA statements in module code to match with READ statements below.
  252. '  Row = starting row for horizontal menu display
  253. '  NHor = number of items in horizontal menu
  254. '  NVerCat = number of horizontal categories (left justified) having vertical menus
  255. '  NMaxVer = maximum number of items in vertical menu (including dividers) for sizing item array
  256. '  HKHor$ = highlight key string for horizontal menu.  Highlite letters in menu items must be in caps.
  257. '           Use "*" character for no highlite letter for a menu item.
  258. '  MnuCtrl(1) = row for horizontal menu.  start vertical window one row lower.
  259. '         (2) = number of horizontal menu items.
  260. '         (3) = number of horizontal items with vertical menus (left-justified).
  261. '         (4-MnuCtrl(2)) = starting column positions of horizontal items.
  262. '         (last  MnuCtrl(3)) = number of items in each vertical menu including divider.
  263. '  A "-" character for an item means a divider for a logical group of
  264. '       selectable menu items.
  265. '  MnuItm1$(1) = string containing highlight keys for horizontal menu.
  266. '          (2-MnuCtrl(2)) = Horizontal menu items displayed on "row".
  267. '          (last MnuCtrl(3)) = highlight key strings for each vertical menu.
  268. '  "-" matches the dash divider. "*" means no highlight for that item.
  269. '  MnuItm2$(i,j) = vertical items (j) for each horizontal menu category (i).
  270. 'No vertical items for a selectable (by highlite key) horizontal category can be used.
  271. '   To make these Alt-Alpha keypresses return from AKMnuCtrl as those with vertical
  272. '   menus, the DATA statement needs to show one dummy vertical menu item that is
  273. '   blank as in:  DATA 1,*,"   "   Non-selectable horizontal categories need to be at
  274. '   the right beyond NVerCat thru NHor.
  275.  
  276. READ Row, NHor, NVerCat, NMaxVer, HKHor$
  277. REDIM MnuCtrl(1 TO NHor + NVerCat + 3), MnuItm1$(1 TO NHor + NVerCat + 1)
  278. REDIM MnuItm2$(1 TO NVerCat, 1 TO NMaxVer)
  279. FOR i = 2 TO NHor + 1
  280.         READ MnuItm1$(i)
  281. NEXT i
  282. MnuItm1$(1) = HKHor$
  283. FOR i = 1 TO NVerCat
  284.         READ MnuCtrl(3 + NHor + i), MnuItm1$(1 + NHor + i)
  285.         FOR j = 1 TO MnuCtrl(3 + NHor + i)
  286.                 READ MnuItm2$(i, j)
  287.         NEXT j
  288. NEXT i
  289. col = 3                                          'Calculate column positions for menus
  290. FOR i = 1 TO NHor
  291.      MnuCtrl(3 + i) = col
  292.      t = LEN(MnuItm1$(i + 1))
  293.      col = col + t + 2
  294. NEXT i
  295. MnuCtrl(1) = Row: MnuCtrl(2) = NHor: MnuCtrl(3) = NVerCat
  296.  
  297. END SUB
  298.  
  299. SUB AKMnuSet (MnuCtrl(), MnuItm1$(), MnuItm2$()) STATIC
  300.  
  301. 'Alt-Key Menu bar generator for use in pull down menu system.
  302. 'Builds menu bar with Alt-key highlight letter for selected category.
  303. 'Use menu forgrnd (.mf) and backgrnd (.mb) with highlight (.hk) key colors.
  304. '  MnuCtrl, MnuItm$ arrays - see AKMnuRead subprogram for definitions
  305.  
  306. COLOR pc.mf, pc.mb
  307. LOCATE MnuCtrl(1), 1, 0                          'Locate on desired row
  308. PRINT SPACE$(80);
  309. FOR i = 1 TO MnuCtrl(2)
  310.         LOCATE , MnuCtrl(3 + i)
  311.         t = LEN(MnuItm1$(1 + i))
  312.         a$ = MID$(MnuItm1$(1), i, 1)
  313.         FOR j = 1 TO t                           'Print menu item with highlight key
  314.                 b$ = MID$(MnuItm1$(1 + i), j, 1)
  315.                 IF b$ = a$ THEN
  316.                         COLOR pc.hk
  317.                         PRINT a$;
  318.                         COLOR tmp
  319.                 ELSE
  320.                         PRINT b$;
  321.                 END IF
  322.         NEXT j
  323. NEXT i
  324. COLOR pc.fg, pc.bg
  325.  
  326. END SUB
  327.  
  328. SUB BlkEdit (Txt$(), LCol, RCol, SRow, ERow, KeyCode) STATIC
  329.  
  330. 'General Purpose Text Block Editing Routine.
  331. 'Modify usable keys and keys that exit as needed.
  332. '  Txt$ = array of ASCII strings that make up block text
  333. '  LCol = starting left column for block
  334. '  RCol = ending right column
  335. '  SRow = starting row for block
  336. '  ERow = ending row
  337. 'Requires KeyPress(KeyCode) subroutine:
  338. '  KeyCode = keycode for key press exiting subroutine.  if just want to print
  339. '             block and exit, set this = 999 on calling BlkEdit.
  340. 'Comment out and/or modify KeyPress select case items to control exit from
  341. ' block.  This routine can be readily used as a line or field input editor.  Call
  342. ' BlkEdit from another routine that filters (min, max, select from table, etc) user
  343. ' input.  If you already have a page text editor with wordwrap, you can scale this
  344. ' routine down to a single line field editor and simplify the coding.
  345. 'Note that the LOCATE cursor height control will not work on some mono and CGA displays.
  346. '  Insert/Overtype still works.  Since this often involves LCD laptops, leaving a large
  347. '  cursor is not undesirable.
  348.  
  349. REDIM a$(SRow TO ERow)
  350. IF ABS(Sdata.vid) = 1 THEN ScnLins = 7 ELSE ScnLins = 13
  351. '  IF Sdata.vid = 0 THEN ScnLins = 13 ELSE ScnLins = 7 is safer if users may have a
  352. '  CGA monitor with EGA or VGA card.  Otherwise, this is not as attractive a cursor.
  353. IF OvrTyp THEN CursStrt = ScnLins * .6 ELSE CursStrt = 0   'Initial call in insert mode
  354. LinLen = RCol - LCol + 1: NumRow = ERow - SRow + 1
  355.  
  356. FOR i = SRow TO ERow                   'Set input text lines into a$ for edit
  357.      a$(i) = SPACE$(LinLen)
  358.      LSET a$(i) = Txt$(i - SRow + 1)
  359.      LOCATE i, LCol, 0                 'Print in block set by rows & columns
  360.      PRINT a$(i);
  361. NEXT i
  362.  
  363. IF KeyCode = 999 THEN EXIT SUB         'Use for printing text block and returning
  364.  
  365. buffer$ = SPACE$(LinLen)               'Blank line is initial buffer for pasting
  366. CursCol = 1: CursRow = SRow
  367.  
  368. DO                                     'Start edit loop
  369. LOCATE CursRow, CursCol + LCol - 1, 1, CursStrt, ScnLins   'Edit cursor placement
  370. CALL KeyPress(KeyCode)
  371. SELECT CASE KeyCode
  372.      CASE 8                            'Backspace
  373.           IF CursCol > 1 THEN
  374.                IF OvrTyp THEN
  375.                     MID$(a$(CursRow), CursCol, 1) = " ": PRINT " ";
  376.                ELSE
  377.                     MID$(a$(CursRow), CursCol - 1) = MID$(a$(CursRow), CursCol) + " "
  378.                     LOCATE , CursCol + LCol - 2, 0
  379.                     PRINT MID$(a$(CursRow), CursCol - 1);
  380.                END IF
  381.                CursCol = CursCol - 1
  382.           END IF
  383.      CASE 13                           'Carriage Return
  384.           IF NumRow = 1 THEN EXIT DO
  385.           CursCol = 1
  386.           IF CursRow < ERow THEN
  387.             CursRow = CursRow + 1
  388.           ELSE EXIT DO
  389.           END IF
  390.      CASE 27                           'Escape to Exit BlkEdit
  391.           EXIT DO
  392.      CASE 1 TO 6, 32 TO 254            'Print character within ASCII code range
  393.           LOCATE , , 0
  394.           IF OvrTyp THEN
  395.                MID$(a$(CursRow), CursCol) = CHR$(KeyCode): PRINT CHR$(KeyCode);
  396.           ELSE
  397.                MID$(a$(CursRow), CursCol) = CHR$(KeyCode) + MID$(a$(CursRow), CursCol)
  398.                PRINT MID$(a$(CursRow), CursCol);
  399.           END IF
  400.           IF CursCol < LinLen THEN CursCol = CursCol + 1
  401.      CASE -75                          'Left Arrow
  402.           IF CursCol > 1 THEN CursCol = CursCol - 1
  403.      CASE -77                          'Right Arrow
  404.           IF CursCol < LinLen THEN CursCol = CursCol + 1
  405.      CASE -72                          'Up Arrow
  406.           IF NumRow = 1 THEN EXIT DO
  407.           IF CursRow = SRow THEN EXIT DO
  408.           CursRow = CursRow - 1
  409.      CASE -80                          'Down Arrow
  410.           IF NumRow = 1 THEN EXIT DO
  411.           IF CursRow = ERow THEN EXIT DO
  412.           CursRow = CursRow + 1
  413.      CASE -71                          'Home to Column 1
  414.           CursCol = 1
  415.      CASE -79                          'End to Last Character +1
  416.           FOR i = LinLen TO 1 STEP -1
  417.                IF MID$(a$(CursRow), i, 1) <> " " THEN EXIT FOR
  418.           NEXT i
  419.           IF i < LinLen THEN CursCol = i + 1 ELSE CursCol = LinLen
  420.      CASE -82                          'Insert Key to Toggle Overtype to Insert
  421.           OvrTyp = NOT OvrTyp          'Don't go to thin cursor for laptop readibility
  422.           IF OvrTyp THEN CursStrt = ScnLins * .6 ELSE CursStrt = 0
  423.      CASE -83                          'Delete at Cursor
  424.           IF CursCol < LinLen THEN
  425.                 MID$(a$(CursRow), CursCol) = MID$(a$(CursRow), CursCol + 1) + " "
  426.           ELSE MID$(a$(CursRow), CursCol) = " "
  427.           END IF
  428.           LOCATE , , 0
  429.           PRINT MID$(a$(CursRow), CursCol);
  430.      CASE -119                         'Ctrl+Home to go to start of block
  431.           CursRow = SRow: CursCol = 1
  432.      CASE -117                         'Ctrl+End to go to end of block
  433.           FOR i = ERow TO SRow STEP -1
  434.                IF a$(i) <> SPACE$(LinLen) THEN EXIT FOR
  435.           NEXT i
  436.           CursCol = 1
  437.           IF i < ERow THEN CursRow = i + 1 ELSE CursRow = ERow
  438.      'CASE -30, -25                     'Alt+A to add a blank line at cursor or
  439.      '     IF a$(ERow) = SPACE$(LinLen) THEN         'Alt+P to paste buffer
  440.      '          FOR i = ERow - 1 TO CursRow STEP -1
  441.      '               a$(i + 1) = a$(i)
  442.      '          NEXT i
  443.      '          IF KeyCode = -25 THEN
  444.      '               a$(CursRow) = buffer$
  445.      '          ELSE
  446.      '               a$(CursRow) = SPACE$(LinLen)
  447.      '          END IF
  448.      '          FOR i = CursRow TO ERow
  449.      '               LOCATE i, LCol, 0
  450.      '               PRINT a$(i);
  451.      '          NEXT i
  452.      '          CursCol = 1
  453.      '     ELSE                         'Warn of attempt to insert line and lose bottom
  454.      '          SOUND 440, 1            ' line. Requires Deleting bottom line first
  455.      '     END IF
  456.      'CASE -32                          'Alt+D to Delete current line
  457.      '     FOR i = CursRow TO ERow - 1
  458.      '          a$(i) = a$(i + 1)
  459.      '          LOCATE i, LCol, 0
  460.      '          PRINT a$(i);
  461.      '     NEXT i
  462.      '     a$(ERow) = SPACE$(LinLen)
  463.      '     LOCATE ERow, LCol, 0
  464.      '     PRINT a$(ERow);
  465.      '     CursCol = 1
  466.      'CASE -46                          'Alt+C to copy current line to buffer
  467.      '     buffer$ = a$(CursRow)
  468.      CASE -73                          'PageUp
  469.           IF NumRow = 1 THEN EXIT DO
  470.           IF CursRow = SRow THEN EXIT DO
  471.           CursRow = SRow
  472.      CASE -81                          'PageDown
  473.           IF NumRow = 1 THEN EXIT DO
  474.           IF CursRow = ERow THEN EXIT DO
  475.           CursRow = ERow
  476.      'CASE 9                            'Tab for 5 space increments from LCol
  477.      '     i = 1
  478.      '     DO
  479.      '     i = i + 5
  480.      '     LOOP WHILE i <= CursCol
  481.      '     IF i <= LinLen THEN CursCol = i
  482.      'CASE -15                          'Sh+Tab to backup cursor to next Tab Stop
  483.      '     i = 1
  484.      '     DO
  485.      '     i = i + 5
  486.      '     LOOP WHILE i < CursCol
  487.      '     i = i - 5
  488.      '     CursCol = i
  489.      CASE ELSE
  490.           EXIT DO
  491.      END SELECT
  492. LOOP
  493.  
  494. FOR i = SRow TO ERow                   'Put edited lines back in Txt$
  495.      Txt$(i - SRow + 1) = RTRIM$(a$(i))
  496. NEXT i
  497. LOCATE , , 0
  498. ERASE a$
  499.  
  500. END SUB
  501.  
  502. SUB BoxDisplay (Nitm, Nstrt, Txt$(), Ctrl, SDLin, ColCod$, Shdw, SelKey) STATIC
  503.  
  504. 'Displays Box centered on screen with menu or message items inside.
  505. 'Can be used as a scroll box for multi-screen menu items.
  506. '  Nitm = number of items in displayed lines.
  507. '  Nstrt = starting row for highlighted item for Ctrl=5 displays (good for window returns)
  508. '  Txt$(i) = array of displayed lines.
  509. '  Ctrl = 0,1 for <=15 centered lines; = 2,3 for left justified lines;
  510. '         (0,2 wait for key press.  1,3 display box and return)
  511. '       = 4 for selecting one item by first character or return (=Esc)
  512. '       = 5 for selecting list item via highlight bar plus Return. first letter
  513. '           match moves highlight bar to that location.  This is the normal scroll box.
  514. '  SDLin = single or double line option, = 1 or 2, for box
  515. '  ColCod$ = box color codes: = w for window, = g for text, = m for menu colors
  516. '  Shdw = adds shadow to box if = 1
  517. '  SelKey = array item number selected. = 0 if <Esc> or return without selection.
  518. 'Saves current video page to page 3 based on menu system and other program sections
  519. ' using 1-2 for nested windows and switching between views.
  520. 'Requires ScrnCopy, BoxDraw, KeyPress
  521.  
  522. CALL ScrnCopy(0, 3)                              'Save current video page
  523. IF ColCod$ = "w" THEN                            'Determine colors to use
  524.     FGrnd = pc.wf: BGrnd = pc.wb
  525. ELSEIF ColCod$ = "g" THEN
  526.     FGrnd = pc.fg: BGrnd = pc.bg
  527. ELSE
  528.     FGrnd = pc.mf: BGrnd = pc.mb
  529. END IF
  530.  
  531. ndlins = Nitm
  532. IF Nitm > 15 THEN ndlins = 15                       '15 max lines in box
  533. rstrt = (21 - ndlins) \ 2                        'Set row positions
  534. rend = rstrt + 3 + ndlins
  535. LinLen = 0                                       'Find longest line length
  536. FOR i = 1 TO Nitm
  537.         a = LEN(Txt$(i))
  538.         IF a > LinLen THEN LinLen = a
  539. NEXT i
  540. cstrt = (76 - LinLen) \ 2                        'Set column positions
  541. cend = cstrt + 3 + LinLen
  542. CALL BoxDraw(cstrt, cend, rstrt, rend, 1, SDLin, FGrnd, BGrnd, Shdw)  'Draw box
  543. rstrt = rstrt + 1: rmsgt = 1                     'Prepare for inside text
  544. IF Ctrl < 5 THEN                                 'Print messages here
  545.         IF Ctrl < 2 THEN                         'Centered message
  546.                 FOR i = 1 TO ndlins
  547.                         CALL CenterLin(rstrt + i, cstrt + 2, cend - 2, Txt$(i))
  548.                 NEXT i
  549.                 IF Ctrl = 1 THEN EXIT SUB
  550.         ELSE
  551.                 FOR i = 1 TO ndlins              'Left-justified message
  552.                         LOCATE rstrt + i, cstrt + 2
  553.                         PRINT Txt$(i);
  554.                 NEXT i
  555.                 IF Ctrl = 3 THEN EXIT SUB
  556.         END IF
  557. CALL KeyPress(SelKey)
  558. IF SelKey > 47 AND SelKey < 123 THEN             'Could be Alpha-Num keypress
  559.         IF Ctrl = 4 THEN                         'If select option, then search for match
  560.                 t$ = UCASE$(CHR$(SelKey))
  561.                 FOR i = 1 TO Nitm
  562.                         IF UCASE$(MID$(Txt$(i), 1, 1)) = t$ THEN
  563.                                 SelKey = i: CALL ScrnCopy(3, 0)
  564.                                 EXIT SUB
  565.                         END IF
  566.                 NEXT i
  567.         END IF
  568. END IF
  569. SelKey = 0: CALL ScrnCopy(3, 0)
  570. EXIT SUB                 'No match or <Esc>
  571. END IF
  572. cstrt = cstrt + 1                                'Prepare for menu items for Ctrl=5
  573. ract = Nstrt: lin$ = SPACE$(LinLen)
  574. MsgStrt:
  575. FOR i = 1 TO ndlins                              'Print menu items
  576.         LOCATE rstrt + i, cstrt
  577.         IF (rmsgt + i - 1) <= Nitm THEN
  578.                 LSET lin$ = Txt$(rmsgt + i - 1)
  579.                 IF i = ract THEN                 'Reverse colors on highlight row
  580.                         COLOR BGrnd, FGrnd
  581.                         PRINT " "; lin$; " ";
  582.                         COLOR FGrnd, BGrnd
  583.                 ELSE
  584.                         PRINT " "; lin$; " ";
  585.                 END IF
  586.         ELSE
  587.                 PRINT SPACE$(LinLen + 2)         'If not enough items to fill box, then
  588.         END IF                                   'print blank lines
  589. NEXT i
  590. CALL KeyPress(KeyCode)                           'Get keypress for action
  591. SELECT CASE KeyCode
  592.         CASE IS = 27                             'Esc
  593.                 SelKey = 0
  594.                 CALL ScrnCopy(3, 0)
  595.                 EXIT SUB
  596.         CASE IS = 13                             'Return with highlight item
  597.                 SelKey = rmsgt + ract - 1
  598.                 CALL ScrnCopy(3, 0)
  599.                 EXIT SUB
  600.         CASE 65 TO 90, 97 TO 122                 'Locate first occurrence of keypress
  601.                 t$ = UCASE$(CHR$(KeyCode))       ' letter and make it the highlighted item
  602.                 FOR i = 1 TO Nitm
  603.                         IF UCASE$(MID$(Txt$(i), 1, 1)) = t$ THEN
  604.                                 IF (i < rmsgt + ndlins) AND (i >= rmsgt) THEN
  605.                                         ract = i - rmsgt + 1
  606.                                 ELSE
  607.                                         rmsgt = i: ract = 1
  608.                                 END IF
  609.                                 GOTO MsgStrt:
  610.                         END IF
  611.                 NEXT i
  612.         CASE IS = -71, -35                       'Home, Alt-H - go to first item
  613.                 rmsgt = 1: ract = 1
  614.         CASE IS = -79, -18                       'End, Alt-E  - go to last item
  615.                 ndlast = Nitm - (Nitm \ ndlins) * ndlins
  616.                 IF ndlast = 0 THEN
  617.                         ract = ndlins
  618.                         rmsgt = Nitm - ndlins + 1
  619.                 ELSE
  620.                         ract = ndlast: rmsgt = Nitm - ndlast + 1
  621.                 END IF
  622.         CASE IS = -73, -22                       'PgUp, Alt-U - go to top of window, then
  623.                 IF ract = 1 THEN                        'scroll to next block of lines
  624.                         rmsgt = rmsgt - ndlins
  625.                         IF rmsgt < 1 THEN rmsgt = 1
  626.                 ELSE
  627.                         ract = 1
  628.                 END IF
  629.         CASE IS = -81, -32                       'PgDn, Alt-D - go to btm of window, then
  630.                 IF rmsgt + ndlins - 1 >= Nitm THEN         'scroll to next block of lines
  631.                         ract = Nitm - rmsgt + 1     'Check for last screen
  632.                 ELSE
  633.                         IF ract < ndlins THEN
  634.                                 ract = ndlins
  635.                         ELSE
  636.                                 rmsgt = rmsgt + ndlins
  637.                                 ract = 1
  638.                         END IF
  639.                 END IF
  640.         CASE IS = -72                            'Up Arrow
  641.                 IF ract > 1 THEN
  642.                         ract = ract - 1
  643.                 ELSE
  644.                         IF rmsgt > 1 THEN rmsgt = rmsgt - 1
  645.                 END IF
  646.  
  647.         CASE IS = -80, 32                        'Down Arrow, space
  648.                 IF rmsgt + ndlins - 1 >= Nitm THEN
  649.                         IF ract < Nitm - rmsgt + 1 THEN ract = ract + 1
  650.                 ELSE
  651.                         IF ract = ndlins THEN
  652.                                 rmsgt = rmsgt + 1
  653.                         ELSE
  654.                                 ract = ract + 1
  655.                         END IF
  656.                 END IF
  657.         CASE ELSE
  658. END SELECT
  659. GOTO MsgStrt:
  660.  
  661. END SUB
  662.  
  663. SUB BoxDraw (LCol, RCol, SRow, ERow, BFil, Brdr, FGrnd, BGrnd, Shdw) STATIC
  664.  
  665. 'Draws a Box for use of on screen windows in program.
  666. 'Plain box or optional single or double line border box with optional shadow.
  667.  
  668. '  LCol = starting left column of box
  669. '  RCol = ending right column
  670. '  SRow = starting row of box
  671. '  ERow = ending row
  672. '  BFil = if =1 then fills in box with background color
  673. '  Brdr = if =1/2 then uses single/double line border for box
  674. '  FGrnd = box foreground color
  675. '  BGrnd = box background color.  will use color 0 for box shadow.
  676. '  Shdw = shadow option if =1
  677.  
  678. COLOR FGrnd, BGrnd                               'Set box window colors
  679. IF BFil = 1 THEN                                 'Fill in box with blank spaces
  680.         FOR i = SRow TO ERow
  681.                 LOCATE i, LCol, 0
  682.                 PRINT SPACE$(RCol - LCol + 1);
  683.         NEXT i
  684. END IF
  685.  
  686. IF Brdr = 0 THEN EXIT SUB                        'If no border then exit
  687. IF Brdr = 1 THEN                                 'Set ASCII code border characters
  688.         c1 = 196: c2 = 179: c3 = 218: c4 = 191: c5 = 192: c6 = 217
  689. ELSE
  690.         c1 = 205: c2 = 186: c3 = 201: c4 = 187: c5 = 200: c6 = 188
  691. END IF
  692.  
  693. LOCATE SRow, LCol + 1                            'Print top and bottom borders
  694. PRINT STRING$(RCol - LCol - 1, c1);
  695. LOCATE ERow, LCol + 1
  696. PRINT STRING$(RCol - LCol - 1, c1);
  697. LOCATE ERow + 1, LCol + 2
  698. IF Shdw = 1 THEN                                 'Print bottom shadow
  699.     COLOR 0: PRINT STRING$(RCol - LCol + 1, 219); : COLOR FGrnd, BGrnd
  700. END IF
  701. FOR i = SRow + 1 TO ERow - 1                     'Print side borders
  702.         LOCATE i, LCol
  703.         PRINT CHR$(c2);
  704.         LOCATE i, RCol
  705.         PRINT CHR$(c2);
  706.         IF Shdw = 1 THEN                         '+ Right-side shadow
  707.             COLOR 0: PRINT STRING$(2, 219); : COLOR FGrnd
  708.         END IF
  709. NEXT i
  710.  
  711. LOCATE SRow, LCol: PRINT CHR$(c3);               'Print corner lines
  712. LOCATE SRow, RCol: PRINT CHR$(c4);
  713. LOCATE ERow, LCol: PRINT CHR$(c5);
  714. LOCATE ERow, RCol: PRINT CHR$(c6);
  715. IF Shdw = 1 THEN                                 '+ Lower-right shadow
  716.     COLOR 0: PRINT STRING$(2, 219); : COLOR FGrnd
  717. END IF
  718.  
  719. END SUB
  720.  
  721. SUB CenterLin (Row, LCol, RCol, Text$) STATIC
  722.  
  723. 'Centers a line of Text on Row within L and R Columns
  724. '  Row = Row for printing line
  725. '  L,RCol = Starting left and ending right column for centering
  726. '  Text$ = String of text to center
  727.  
  728. dlen = (RCol - LCol - LEN(Text$) + 1) \ 2
  729. IF dlen < 0 THEN EXIT SUB
  730. LOCATE Row, LCol + dlen
  731. PRINT Text$;
  732.  
  733. END SUB
  734.  
  735. SUB DialogBox (Ddflts$, Dsin$, Dsout$, KeyCode, DBCode) STATIC
  736.  
  737. 'Displays dialog box in response to Alt-Key Menu item selection.
  738. 'Is independent of the AKMnu system and called by MainCalc in response to a
  739. ' particular menu system selection.
  740. 'In general it sets up a list of fixed categories on the left and allows the
  741. ' user to select or edit a list of items positioned at the right of each category.
  742. 'Use cursor movement keys to get highlite bar to desired category.
  743. '<CR> then lets you modify item for that category.  <CR> returns to the dialog
  744. ' box categories. <Esc> returns to pull-down menu system with selected items.
  745. 'DATA statements building the menu are the following:
  746. ' -  Dialog Box Title (optional), number of following data statements ("ncat")
  747. ' -  "ncat" data statements describing categories for dialog
  748. ' -  Optional default starting list of all dialog items
  749. 'The different categories of dialog input are the following:
  750. '   1 - text input by user into a defined field.  Uses BlkEdit for the field editor.
  751. '   2 - select a single item from a vertical box menu.  Uses BoxDisplay.
  752. '   3 - displays options for a category.  One option is selected by moving a "*"
  753. '         character with the cursor keys.
  754. '   4 - a category is toggled for select or not as noted by a check character.
  755. '   5 - a row of boxed "control buttons".  Only one row permitted.  <CR> on these
  756. '         exits the routine to allow user adjustment of input items and optional
  757. '         return to the routine.
  758. '   6 - a line of explanatory text that cannot be selected.  Can be blank and used
  759. '         as a spacer to better display related categories.  Top and bottom categories
  760. '         can be number 6's.  No more than one 6 can be used in adjacent positions.
  761. '   7 - an optional string containing the default or startup list of items.  Is not
  762. '         a displayed category.
  763. 'The format of the category data statements are as follows.  0 means not selected and 1
  764. '   or 1 thru n for multiple items means that item is selected.
  765. '   1 - type, hilite key letter, category name, field length for editing.
  766. '   2 - type, hilite key letter, category name, no. of selectable items, list of
  767. '         items with "/" separator
  768. '   3 - (same as 2)
  769. '   4 - type, hilite key letter, category name
  770. '   5 - type, hilite key string, no. of control buttons, list of controls with
  771. '          "/" separator
  772. '   6 - type, string (including blank)
  773. '   7 - type, string containing initial category selections with "/" separator.  Include
  774. '         entries for all 1-5 category items.  (Start cat 5 with "0")
  775. 'Routine I/O is the following:
  776. '   Ddflts$ - optional default string of items.
  777. '   Dsin$   - input list of selected items
  778. ' (For both of these variables, the calling routine must control the format, especially the 
  779. '  length of any category 1 input string.  BlkEdit will limit length, but longer items can be printed.)
  780. '   Dsout$  - list of selected items upon exit from routine
  781. '   KeyCode - 0 for <Esc> or 1-n for 1-n control button selection
  782. '   DBCode  - operating direction code.  initial call to routine with 1 to
  783. '               read and build dialog box.  Return after category 5 exit with DBCode=2.
  784. '               Although somewhat complicated, this allows great flexibility in controlling
  785. '               allowable input in your program.  Program and user defaults can be used.
  786. 'Requires KeyPress, BlkEdit, BoxDisplay, CenterLin, pc.(PgmColors) using menu and background colors.
  787.  
  788. Dsout$ = Dsin$: Dtmp$ = Dsin$                    'Store input item string
  789. IF DBCode = 2 THEN GOTO DBoxLoop1:               'If returning from ctrl button exit, resume
  790. CALL ScrnCopy(0, 1)                              'Save current screen
  791. READ title$, ncat                                'Read dialog box description
  792. REDIM hlk$(1 TO ncat), cat(1 TO ncat, 1 TO 5), drow$(1 TO ncat, 1 TO 3)
  793. ' cat (1 to 5) are: type, cat len, item max len, no. items, strt row offset
  794. ' drow$ (1 to 3) are: cat, items, selected item
  795. lcat = 0: litm = 0: llins = 0: lmax = 0          'Find max length of category, items, total width
  796. FOR i = 1 TO ncat
  797.     READ cat(i, 1)                               'Category of dialog item
  798.     SELECT CASE cat(i, 1)
  799.         CASE IS = 1                              'Input field type
  800.             llins = llins + 1: cat(i, 5) = llins
  801.             READ hlk$(i), drow$(i, 1), cat(i, 3)   'Highlite key, Name and input length
  802.             cat(i, 2) = LEN(drow$(i, 1))         'Length of name
  803.             IF cat(i, 2) > lcat THEN lcat = cat(i, 2)  'Find longest lengths
  804.             IF cat(i, 3) > litm THEN litm = cat(i, 3)
  805.         CASE IS = 2, 3                           'Menu or (*) list item
  806.             READ hlk$(i), drow$(i, 1), cat(i, 4), drow$(i, 2) 'Hilite key, category, no of items, itm list (/separator)
  807.             cat(i, 2) = LEN(drow$(i, 1))
  808.             IF cat(i, 2) > lcat THEN lcat = cat(i, 2)
  809.             cat(i, 3) = 0: istrt = 0
  810.             FOR k = 1 TO LEN(drow$(i, 2))        'Find length of longest menu item
  811.                 IF MID$(drow$(i, 2), k, 1) = "/" THEN
  812.                     IF istrt > cat(i, 3) THEN cat(i, 3) = istrt
  813.                     istrt = 0
  814.                 ELSE
  815.                     istrt = istrt + 1
  816.                 END IF
  817.             NEXT k
  818.             IF istrt > cat(i, 3) THEN cat(i, 3) = istrt  'Store longest length item
  819.             IF cat(i, 1) = 2 THEN                'Determine row position
  820.                 IF cat(i, 3) > litm THEN litm = cat(i, 3)
  821.                 llins = llins + 1: cat(i, 5) = llins
  822.             ELSE
  823.                 IF cat(i, 3) + 4 > litm THEN litm = cat(i, 3) + 4  'Allow for * select item
  824.                 cat(i, 5) = llins + 1
  825.                 llins = llins + cat(i, 4)
  826.             END IF
  827.         CASE IS = 4                              'Checked option
  828.             llins = llins + 1: cat(i, 5) = llins
  829.             READ hlk$(i), drow$(i, 1)
  830.             cat(i, 2) = LEN(drow$(i, 1))
  831.             IF cat(i, 2) > lcat THEN lcat = cat(i, 2)
  832.             IF litm < 1 THEN litm = 1
  833.         CASE IS = 5                              'Single set of control buttons allowed
  834.             cat(i, 5) = llins + 2
  835.             llins = llins + 3
  836.             READ hlk$(i), cat(i, 4), drow$(i, 1)  'No of items, list (/ separator)
  837.             cat(i, 2) = LEN(drow$(i, 1)) + (cat(i, 4) - 1) * 3 + 2
  838.             IF cat(i, 2) > lmax THEN lmax = cat(i, 2)
  839.             REDIM itm5$(1 TO cat(i, 4)), col5(1 TO cat(i, 4), 1 TO 2), hlk5$(1 TO cat(i, 4))
  840.             k = 1
  841.             FOR j = 1 TO LEN(drow$(i, 1))
  842.                 a$ = MID$(drow$(i, 1), j, 1)
  843.                 IF a$ = "/" THEN
  844.                     k = k + 1
  845.                 ELSE
  846.                     itm5$(k) = itm5$(k) + a$
  847.                 END IF
  848.             NEXT j
  849.             FOR j = 1 TO cat(i, 4)
  850.                 hlk5$(j) = MID$(hlk$(i), j, 1)
  851.                 col5(j, 2) = LEN(itm5$(j))
  852.             NEXT j
  853.         CASE IS = 6                              'User defined string.  Typically
  854.             llins = llins + 1                    ' separator bar or subheading
  855.             cat(i, 5) = llins
  856.             READ drow$(i, 1)
  857.             cat(i, 2) = LEN(drow$(i, 1))
  858.             IF cat(i, 2) > lmax THEN lmax = cat(i, 2)
  859.         CASE IS = 7                              'Startup default string
  860.             READ Ddflts$
  861.             ncat = ncat - 1                      'Retain only categories for print rows
  862.     END SELECT
  863. NEXT i
  864. IF Dsin$ = "" THEN                               'If no Dsin$ on initial call, assume
  865.     Dsin$ = Ddflts$: Dsout$ = Ddflts$: Dtmp$ = Ddflts$   'default is provided
  866. END IF
  867.  
  868. rstrt = (21 - llins) \ 2                         'Set up box positions
  869. rend = rstrt + llins + 1
  870. lmax = lmax + 2
  871. IF lcat + litm + 4 > lmax THEN lmax = lcat + litm + 4   'Be sure wide enough
  872. cstrt = (78 - lmax) \ 2                          'Start, end columns
  873. cend = cstrt + lmax + 2
  874. CALL BoxDraw(cstrt, cend, rstrt, rend, 1, 1, pc.mf, pc.mb, 1)   'Draw dialog box in menu colors
  875. IF title$ > " " THEN CALL CenterLin(rstrt, cstrt, cend, title$) 'Put title in box top bar
  876. cstrt = cstrt + 2: cistrt = cstrt + lcat + 2     'Category and item starting columns
  877.  
  878. FOR i = 1 TO ncat                                'Calc locations and print categories
  879.     SELECT CASE cat(i, 1)
  880.         CASE 1 TO 4, 6                           'Categories 1-4 and 6
  881.             LOCATE rstrt + cat(i, 5), cstrt
  882.             FOR j = 1 TO cat(i, 2)
  883.                 a$ = MID$(drow$(i, 1), j, 1)
  884.                 IF hlk$(i) = a$ THEN             'If at hilite key position, print letter
  885.                     COLOR pc.hk
  886.                     PRINT hlk$(i);
  887.                     COLOR pc.mf
  888.                 ELSE
  889.                     PRINT a$;                    'Print normal category letter
  890.                 END IF
  891.             NEXT j
  892.             IF cat(i, 1) = 3 THEN                'For category 3, display selectable items
  893.                 il = 0
  894.                 FOR j = 1 TO cat(i, 4)
  895.                     i$ = ""
  896.                     DO
  897.                         il = il + 1
  898.                         a$ = MID$(drow$(i, 2), il, 1)
  899.                         IF a$ = "/" THEN
  900.                             EXIT DO
  901.                         ELSE
  902.                             i$ = i$ + a$
  903.                         END IF
  904.                     LOOP UNTIL LEN(drow$(i, 2)) = il
  905.                     LOCATE rstrt + cat(i, 5) + j - 1, cistrt
  906.                     PRINT i$;
  907.                 NEXT j
  908.             END IF
  909.         CASE IS = 5                              'Control buttons are special
  910.             lspc = (lmax - cat(i, 2)) \ 2        'Max length of ctrl btm line
  911.             col5(1, 1) = cstrt + lspc + 1
  912.             FOR j = 2 TO cat(i, 4)
  913.                 col5(j, 1) = col5(j - 1, 1) + col5(j - 1, 2) + 4
  914.             NEXT j
  915.             rs = rstrt + cat(i, 5) - 1: re = rs + 2
  916.             FOR j = 1 TO cat(i, 4)               'Put boxes around text
  917.                 cs = col5(j, 1) - 1: ce = cs + col5(j, 2) + 1
  918.                 CALL BoxDraw(cs, ce, rs, re, 0, 1, pc.mf, pc.mb, 0)
  919.                 LOCATE rs + 1, col5(j, 1)
  920.                 FOR k = 1 TO col5(j, 2)
  921.                     a$ = MID$(itm5$(j), k, 1)
  922.                     IF hlk5$(j) = a$ THEN        'Each button can have a hilite key
  923.                         COLOR pc.hk
  924.                         PRINT hlk5$(j);
  925.                         COLOR pc.mf
  926.                     ELSE
  927.                         PRINT a$;
  928.                     END IF
  929.                 NEXT k
  930.             NEXT j
  931.         CASE ELSE
  932.     END SELECT
  933. NEXT i
  934. CALL ScrnCopy(0, 2)                              'Save the dialog box screen with categories
  935. cstrt = cstrt - 1
  936. IF cat(1, 1) > 5 THEN ract = 2 ELSE ract = 1     'Set starting point. ract is active row
  937. c5itm = 1                                        'Initially go to first control button
  938. lini$ = SPACE$(litm)                             'Item input variable
  939.  
  940. DBoxLoop1:                                       'Return point for ctrl button action
  941. GOSUB DStrItm:                                   'Put string into items in case it changed
  942. DBoxLoop2:                                       'Loop for printing items after each category
  943. CALL ScrnCopy(2, 0)                              'Recall the box
  944. COLOR pc.bg, pc.mb
  945. FOR i = 1 TO ncat                                'Loop thru the categories and print
  946.     LOCATE rstrt + cat(i, 5)
  947.     SELECT CASE cat(i, 1)
  948.         CASE IS = 1, 2
  949.             LOCATE , cistrt
  950.             LSET lini$ = drow$(i, 3)
  951.             PRINT lini$;                         'Print input string in field
  952.         CASE IS = 3
  953.             FOR j = 1 TO cat(i, 4)
  954.                 LOCATE rstrt + cat(i, 5) + j - 1, cistrt + cat(i, 3) + 2
  955.                 IF j = VAL(drow$(i, 3)) THEN
  956.                     i$ = "*"
  957.                 ELSE
  958.                     i$ = " "
  959.                 END IF
  960.                 PRINT "("; i$; ")";              'Print empty or selected item
  961.             NEXT j
  962.         CASE IS = 4
  963.             IF drow$(i, 3) = "1" THEN            'If selected (=1) then print
  964.                 LOCATE , cistrt
  965.                 PRINT CHR$(251);                 'Use divider character as "check"
  966.             END IF
  967.         CASE ELSE
  968.     END SELECT
  969. NEXT i
  970. CALL ScrnCopy(0, 3)                              'Save complete dialog box without hilite bar
  971.  
  972. DBoxLoop3:                                       'Primary loop for displaying hilite bar
  973. CALL ScrnCopy(3, 0)
  974. COLOR pc.mb, pc.mf
  975. IF cat(ract, 1) = 5 THEN                         'Special treatment of control buttons
  976.     LOCATE rstrt + cat(ract, 5), col5(c5itm, 1)
  977.     PRINT itm5$(c5itm);
  978.     a$ = MID$(hlk$(ract), c5itm, 1)
  979.     b = INSTR(itm5$(c5itm), a$)
  980.     IF b > 0 THEN
  981.         LOCATE , col5(c5itm, 1) + b - 1
  982.         COLOR pc.hk
  983.         PRINT a$;
  984.         COLOR pc.mf
  985.     END IF
  986. ELSE                                             'Display hilite bar for other categories
  987.     LOCATE rstrt + cat(ract, 5), cstrt
  988.     PRINT " "; drow$(ract, 1); TAB(cistrt - 1);
  989.     b = INSTR(drow$(ract, 1), hlk$(ract))
  990.     IF b > 0 THEN
  991.         LOCATE , cstrt + b
  992.         COLOR pc.hk
  993.         PRINT hlk$(ract);
  994.         COLOR pc.mf
  995.     END IF
  996. END IF
  997.  
  998. DBoxLoop4:                                       'Loop for moving hilite bar and selecting categories
  999. CALL KeyPress(KeyCode)
  1000. SELECT CASE KeyCode
  1001.     CASE IS = 27                                 'Update and escape
  1002.         KeyCode = 0
  1003.         c5itm = 0                                'Not an exit with a control button
  1004.         GOSUB DItmStr:                           'Store selected items in string
  1005.         GOTO DBExit:
  1006.     CASE IS = 13                                 'Alter or select this item
  1007.         CALL ScrnCopy(3, 0)                      'Makes category highlite go away during item edit
  1008.         GOTO DBoxLoop5:
  1009.     CASE 65 TO 90, 97 TO 122, 48 TO 57           'Letters and numbers
  1010.         t$ = UCASE$(CHR$(KeyCode))
  1011.         FOR i = 1 TO ncat
  1012.             IF cat(i, 1) = 5 THEN
  1013.                 c5itm = INSTR(UCASE$(hlk$(i)), t$)
  1014.                 IF c5itm > 0 THEN
  1015.                     ract = i
  1016.                     GOTO DBoxLoop3:
  1017.                 END IF
  1018.                 c5itm = 1
  1019.             ELSE
  1020.                 IF UCASE$(hlk$(i)) = t$ THEN
  1021.                     ract = i
  1022.                     GOTO DBoxLoop3:
  1023.                 END IF
  1024.             END IF
  1025.         NEXT i
  1026.     CASE IS = -72, -22                           '<Up>,Alt-U
  1027.         IF ract > 1 THEN
  1028.             ract = ract - 1
  1029.             IF cat(ract, 1) > 5 THEN
  1030.                 IF ract > 1 THEN ract = ract - 1 ELSE ract = ract + 1
  1031.             END IF
  1032.         GOTO DBoxLoop3:
  1033.         END IF
  1034.     CASE IS = -80, -32, 32                       '<Down>,Alt-D,<Space>
  1035.         IF ract < ncat THEN
  1036.             ract = ract + 1
  1037.             IF cat(ract, 1) = 6 THEN
  1038.                 IF ract < ncat THEN ract = ract + 1 ELSE ract = ract - 1
  1039.             END IF
  1040.         GOTO DBoxLoop3:
  1041.         END IF
  1042.     CASE IS = -73, -71, -35                      '<PgUp>,Home,Alt-H
  1043.         IF cat(1, 1) = 6 THEN ract = 2 ELSE ract = 1
  1044.         GOTO DBoxLoop3:
  1045.     CASE IS = -81, -79, -18                      '<PgDn>,End,Alt-E
  1046.         IF cat(ncat, 1) = 6 THEN ract = ncat - 1 ELSE ract = ncat
  1047.         GOTO DBoxLoop3:
  1048.     CASE IS = -75, -38                           '<Left>,Alt-L
  1049.         IF cat(ract, 1) = 5 THEN
  1050.             IF c5itm = 1 THEN
  1051.                 c5itm = cat(ract, 4)
  1052.             ELSE
  1053.                 c5itm = c5itm - 1
  1054.             END IF
  1055.         END IF
  1056.         GOTO DBoxLoop3:
  1057.     CASE IS = -77, -19                           '<Right>,Alt-R
  1058.         IF cat(ract, 1) = 5 THEN
  1059.             IF c5itm = cat(ract, 4) THEN
  1060.                 c5itm = 1
  1061.             ELSE
  1062.                 c5itm = c5itm + 1
  1063.             END IF
  1064.         END IF
  1065.         GOTO DBoxLoop3:
  1066.     CASE ELSE                                    'Allow for any other keypress
  1067. END SELECT
  1068. GOTO DBoxLoop4:
  1069.  
  1070. DBoxLoop5:                                       'Section for updating items
  1071. COLOR pc.mb, pc.mf
  1072. SELECT CASE cat(ract, 1)
  1073.     CASE IS = 1
  1074.         REDIM itm$(1 TO 1)
  1075.         itm$(1) = drow$(ract, 3)                  'Allow user to edit field via itm$
  1076.         CALL BlkEdit(itm$(), cistrt, cistrt + cat(ract, 3) - 1, rstrt + cat(ract, 5), rstrt + cat(ract, 5), KeyCode)
  1077.         drow$(ract, 3) = itm$(1)
  1078.     CASE IS = 2
  1079.         REDIM itm$(1 TO cat(ract, 4))            'Set up selectable items in array
  1080.         k = 0: l = 1
  1081.         FOR i = 1 TO cat(ract, 4)                'Extract from /-separated list
  1082.             itm$(i) = ""
  1083.             FOR j = l TO LEN(drow$(ract, 2))
  1084.                 a$ = MID$(drow$(ract, 2), j, 1)
  1085.                 IF a$ = "/" THEN EXIT FOR
  1086.                 itm$(i) = itm$(i) + a$
  1087.             NEXT j
  1088.         l = j + 1
  1089.         IF itm$(i) = drow$(ract, 3) THEN k = i
  1090.         NEXT i
  1091.         IF k < 1 THEN k = 1                      'Display as new menu using window colors
  1092.         CALL BoxDisplay(cat(ract, 4), k, itm$(), 5, 2, "w", 1, SelKey)
  1093.         IF SelKey < 1 THEN SelKey = k            'If <Esc> retain first item
  1094.         drow$(ract, 3) = itm$(SelKey)
  1095.     CASE IS = 3
  1096.         ri = rstrt + cat(ract, 5) - 1            'Set up variables to move "*" around
  1097.         ci = cistrt + cat(ract, 3) + 2
  1098.         ni = VAL(drow$(ract, 3))
  1099.         DO
  1100.         FOR i = 1 TO cat(ract, 4)                 'Print blank or character
  1101.             LOCATE ri + i, ci
  1102.             IF i = ni THEN PRINT "(*)";  ELSE PRINT "( )";
  1103.         NEXT i
  1104.         CALL KeyPress(KeyCode)
  1105.         SELECT CASE KeyCode
  1106.             CASE IS = 27, 13, -75, -38, -77, -19  'Go back to category
  1107.                 drow$(ract, 3) = STR$(ni)
  1108.                 EXIT DO
  1109.             CASE IS = -72, -22                    'Up movement
  1110.                 IF ni > 1 THEN ni = ni - 1 ELSE ni = cat(ract, 4)
  1111.             CASE IS = -80, -32, 32                'Down movement
  1112.                 IF ni < cat(ract, 4) THEN ni = ni + 1 ELSE ni = 1
  1113.             CASE IS = -73, -71, -35               'First item
  1114.                 ni = 1
  1115.             CASE IS = -81, -79, -18               'Last item
  1116.                 ni = cat(ract, 4)
  1117.             CASE 49 TO 57                         'Can select by number
  1118.                 ni = KeyCode - 48
  1119.                 IF ni > cat(ract, 4) THEN ni = cat(ract, 4)
  1120.             CASE ELSE                             'Allow for user errors
  1121.         END SELECT
  1122.         LOOP
  1123.     CASE IS = 4
  1124.         LOCATE rstrt + cat(ract, 5), cistrt
  1125.         IF drow$(ract, 3) = "1" THEN             'Toggle selection
  1126.             drow$(ract, 3) = "0"
  1127.             PRINT " ";
  1128.         ELSE
  1129.             drow$(ract, 3) = "1"
  1130.             PRINT CHR$(251);
  1131.         END IF
  1132.     CASE IS = 5
  1133.         GOSUB DItmStr:                           'Store current items in string
  1134.         KeyCode = c5itm                          'Note which button was <CR>'d
  1135.         EXIT SUB
  1136.     CASE ELSE
  1137. END SELECT
  1138. GOTO DBoxLoop2:                                  'Loop to box item print
  1139.  
  1140. DBExit:
  1141.     CALL ScrnCopy(1, 0)                          'Restore screen and erase arrays
  1142.     ERASE hlk$, cat, drow$, itm5$, col5, hlk5$, itm$
  1143.     title$ = "": Dtmp$ = ""
  1144.     EXIT SUB
  1145.  
  1146. DStrItm:                                         'Put selection string (dtmp$) into individual item variables
  1147.     il = 0
  1148.     FOR i = 1 TO ncat
  1149.         IF cat(i, 1) < 6 THEN
  1150.             drow$(i, 3) = ""
  1151.             DO
  1152.                 il = il + 1
  1153.                 a$ = MID$(Dtmp$, il, 1)
  1154.                 IF a$ = "/" THEN
  1155.                     EXIT DO
  1156.                 ELSE
  1157.                     drow$(i, 3) = drow$(i, 3) + a$
  1158.                 END IF
  1159.             LOOP UNTIL LEN(Dsin$) = il
  1160.         END IF
  1161.     NEXT i
  1162.     RETURN
  1163.  
  1164. DItmStr:                                         'Store individual items in dsout$ string
  1165.     Dsout$ = ""
  1166.     FOR i = 1 TO ncat
  1167.         SELECT CASE cat(i, 1)
  1168.             CASE 1 TO 4
  1169.                 Dsout$ = Dsout$ + drow$(i, 3) + "/"
  1170.             CASE IS = 5
  1171.                 Dsout$ = Dsout$ + STR$(c5itm) + "/"
  1172.             CASE ELSE
  1173.         END SELECT
  1174.     NEXT i
  1175.     Dsout$ = LEFT$(Dsout$, LEN(Dsout$) - 1)
  1176.     RETURN
  1177.  
  1178. END SUB
  1179.  
  1180. SUB KeyPress (KeyCode) STATIC
  1181.  
  1182. 'Processes next keypress in buffer.
  1183. 'Returns negative of second code for extended codes.
  1184.  
  1185. DO
  1186.         ky$ = INKEY$
  1187. LOOP UNTIL LEN(ky$)
  1188. IF LEN(ky$) = 1 THEN
  1189.         KeyCode = ASC(ky$)
  1190. ELSE
  1191.         KeyCode = -ASC(RIGHT$(ky$, 1))
  1192. END IF
  1193.  
  1194. END SUB
  1195.  
  1196. SUB MainCalc STATIC
  1197.  
  1198. 'Dummy main part of program containing menu system
  1199. 'Key items to note are the integer control codes to convert menu items to program
  1200. ' actions and the use of SELECT CASE.
  1201. 'Note that with another set of DATA statements, your program could have two menu systems;
  1202. ' e.g. MainMenu1 and MainMenu2.
  1203. 'If you extend to highly nested menu systems and scroll boxes, beware of running out of
  1204. ' video pages.
  1205.  
  1206. REDIM MnuCtrl(1 TO 1), MnuItm1$(1 TO 1), MnuItm2$(1 TO 1, 1 TO 1)  'For AKMnuRead call
  1207.  
  1208. DIM z$(1 TO 50), y$(1 TO 6)                      'Set up some strings for menu items
  1209. FOR i = 1 TO 50
  1210.         n = 20 * RND(1)
  1211.         z$(i) = ""
  1212.         FOR j = 1 TO n
  1213.                z$(i) = z$(i) + CHR$(65 + 25 * RND(1))
  1214.         NEXT j
  1215. NEXT i
  1216.  
  1217. REDIM a$(1 TO 5)                                 'Set up a block edit field
  1218. a$(1) = "This is a block of text you can edit."
  1219. a$(2) = "Exiting from block with typical keys will go"
  1220. a$(3) = "to a selection box.  Alt-keys activate menus."
  1221.  
  1222.  
  1223. RESTORE MainMenu1:                               'Read menu parameters
  1224. CALL AKMnuRead(MnuCtrl(), MnuItm1$(), MnuItm2$())
  1225.  
  1226. COLOR pc.fg, pc.bg                               'Prepare for screens
  1227. WIDTH 80, 25
  1228. CLS
  1229.                                                  'Let's have a heading
  1230. Text$ = "DEMO  PROGRAM  FOR  WINDOW  -  MENU  SYSTEM"
  1231. COLOR pc.bt
  1232. CALL CenterLin(1, 1, 80, Text$)                  'Put title in center at top
  1233. COLOR pc.fg
  1234. Text$ = " This is Dummy Message Line at Bottom of Screen"  'Reserve last line for pgm comments/help
  1235. CALL StrngBar(25, Text$)
  1236. CALL AKMnuSet(MnuCtrl(), MnuItm1$(), MnuItm2$())  'Display horizontal menu bar
  1237.  
  1238. FOR i = 4 TO 23                                  'Put some stuff on the screen
  1239.         FOR j = 3 TO 78
  1240.                 LOCATE i, j, 0
  1241.                 PRINT CHR$(33 + 90 * RND(1));
  1242.         NEXT j
  1243. NEXT i
  1244. CALL BoxDraw(10, 70, 10, 16, 1, 1, pc.fg, pc.bg, 0)  'Set up box for block edit
  1245. Dsin1$ = "c:\qbasic\*.*/WK2/2/0/1/1/0"            'Set up initial items for dialog box (could be cal'd by pgm)
  1246.  
  1247. AKStart:                                         'Program screen operations
  1248. COLOR pc.fg, pc.bg
  1249. CALL BlkEdit(a$(), 12, 68, 11, 15, KeyCode)      'Start by editing block of text
  1250. SELECT CASE KeyCode                              'Exited block.  Branch based on return KeyCode
  1251.         CASE IS = 13                             'Example action following block edit by <CR>
  1252.                 y$(1) = "Add a new item to list"
  1253.                 y$(2) = "Delete the current item"
  1254.                 y$(3) = "Modify the current item"
  1255.                 y$(4) = "Reconfigure the support plan"
  1256.                 y$(5) = ""
  1257.                 y$(6) = " (Select by First Letter)"
  1258.                 CALL BoxDisplay(6, 1, y$(), 4, 2, "w", 1, SelKey)
  1259.                 IF SelKey > 0 AND SelKey < 5 THEN
  1260.                         y$(2) = y$(SelKey)
  1261.                         y$(1) = "You selected the following program branch ..."
  1262.                         y$(3) = "< Press Any Key To Continue >"
  1263.                         CALL BoxDisplay(3, 1, y$(), 0, 2, "w", 1, SelKey)
  1264.                 END IF
  1265.                 GOTO AKStart:
  1266.         CASE IS = 27                             '<Esc>. Let's go home
  1267.                 EXIT SUB
  1268.         CASE -50 TO -44, -38 TO -30, -25 TO -16, -68  'Alt-alpha, + F10 key traps to go to menu
  1269. MMenu1Strt:
  1270.             CALL AKMnuCtrl(KeyCode, MnuCtrl(), MnuItm1$(), MnuItm2$(), SelKey)
  1271.         CASE ELSE                                'Would direct to different pgm options
  1272.                 y$(1) = "Main Program Trapped KeyPress = " + STR$(KeyCode)
  1273.                 y$(2) = "Press <Esc> in Main Program to End"
  1274.                 y$(3) = "< Press Any Key To Continue >"
  1275.                 CALL BoxDisplay(3, 1, y$(), 0, 2, "w", 1, SelKey)
  1276.                 GOTO AKStart:
  1277. END SELECT
  1278.  
  1279. Branch = 100 * KeyCode + SelKey                  'Translate menu category and item into an
  1280. SELECT CASE Branch                               'integer for directing program flow
  1281.         CASE IS = 307                            'File-Options menu item to demo dialog box
  1282.                 RESTORE MainDialog1:             'Goto correct DATA statements
  1283.                 DBCode = 1                       'Initial entry code for routine
  1284. MDBoxRtn:
  1285.                 CALL DialogBox(dummy$, Dsin1$, Dsout1$, KeyCode, DBCode)
  1286.                 DBCode = 2                       'Permits reentry to routine
  1287.                 IF KeyCode = 1 THEN Dsin1$ = Dsout1$    '"Update" selection
  1288.                 IF KeyCode = 2 THEN Dsin1$ = dummy$    '"Default" selection
  1289.                 IF KeyCode = 1 OR KeyCode = 2 THEN GOTO MDBoxRtn:
  1290.                 CALL ScrnCopy(1, 0)                   'Return to pull-down menu screen
  1291.                 KeyCode = -47: GOTO MMenu1Strt:
  1292.         CASE IS = 504                                 'Second example dialog box
  1293.                 RESTORE MainDialog2:
  1294.                 Dsin2$ = "2400/1/2/2/TTY/0"
  1295.                 DBCode = 1
  1296.                 CALL DialogBox(dummy$, Dsin2$, Dsout2$, KeyCode, DBCode)
  1297.                 DBCode = 2
  1298.                 CALL ScrnCopy(1, 0)
  1299.                 IF KeyCode = 1 THEN                   'If returned with Connect selection, then "run"
  1300.                     a$(1) = ""
  1301.                     a$(2) = "Your Modem is Dialing ..."
  1302.                     a$(3) = "  (Just Pretending)"
  1303.                     GOTO AKStart:
  1304.                 END IF
  1305.                 KeyCode = -73: GOTO MMenu1Strt:       'If returned with <Esc>, then go back to menu
  1306.         CASE 1 TO 999                                 'Other menu branches
  1307.                 y$(1) = "Perform Action or Go To Program Branch --> " + STR$(Branch)
  1308.                 y$(2) = "Next key press will go to a simulated menu selection process"
  1309.                 CALL BoxDisplay(2, 1, y$(), 2, 2, "w", 1, SelKey)
  1310.                 CALL BoxDisplay(50, 1, z$(), 5, 2, "w", 1, SelKey)  'Select a menu item
  1311.                 IF SelKey = 0 THEN SelKey = 1    'In case no item selected for following display
  1312.                 y$(1) = "Menu item selected and used is --> " + z$(SelKey)
  1313.                 y$(2) = "Program might branch here or use the selected item as input to a field."
  1314.                 CALL BoxDisplay(2, 1, y$(), 0, 2, "w", 1, SelKey)
  1315.        
  1316.         CASE ELSE                                '<Esc> from menu or other abort key
  1317.                 y$(1) = "This is <Esc> or Other Code Displayed for Demo Only"
  1318.                 y$(2) = "KeyCode = " + STR$(KeyCode) + " ;  SelKey = " + STR$(SelKey)
  1319.                 t1 = pc.wf: t2 = pc.wb: pc.wf = 0: pc.wb = 4
  1320.                 CALL BoxDisplay(2, 1, y$(), 0, 2, "w", 1, SelKey)  'Manually change to red for
  1321.                 pc.wf = t1: pc.wb = t2                             ' error or warning
  1322. END SELECT
  1323. GOTO AKStart:                                    'Loop until <Esc>
  1324.  
  1325. END SUB
  1326.  
  1327. SUB ScrnCopy (Src, Dst) STATIC
  1328.  
  1329. 'Copies to/from screen pages.
  1330. 'Will handle CGA - VGA using PCOPY
  1331. 'Monochrome (MDA) will manually poke into host video memory
  1332. 'Without assembly block memory move, will be slow for XT operation.
  1333. ' OK for faster machines.
  1334. 'Uses SystmData variable sdata.vid to determine adapter in use.
  1335. 'Src = source page.  Dst = destination page.
  1336.  
  1337. IF Sdata.vid = 0 THEN
  1338.     DEF SEG = &HB000
  1339.     t1 = 4096 * Src: t2 = 4096 * Dst
  1340.     FOR i = 0 TO 3999
  1341.         POKE (t2 + i), PEEK(t1 + i)
  1342.     NEXT i
  1343.     DEF SEG
  1344. ELSE
  1345.     PCOPY Src, Dst
  1346. END IF
  1347.  
  1348. END SUB
  1349.  
  1350. SUB SetUpPgm STATIC
  1351.  
  1352. 'Dummy setup routine for program.  Would normally parse command line for
  1353. ' B/W monitor option and determine video adapter from the equipment list found
  1354. ' in memory.  These then determine the value for Sdata.vid.
  1355. 'Be sure Sdata.vid matches with your computer display mode.
  1356. 'SUPPRT.ZIP found in the CIS MS Basic Library contains module SUPPRT1.BAS.  This
  1357. ' module provides QB routines for determining your system hardware and reading
  1358. ' the command line.
  1359. 'Note: You can allow your program users to set Sdata.vid numbers by displaying combos
  1360. ' of foreground and background colors for selection.  Don't be surprised what colors
  1361. ' some people pick, so try not to restrict them.
  1362. 'The following provides some examples based on the recommended use of an Sdata.vid
  1363. ' integer code.
  1364.  
  1365. Sdata.vid = 3         ' <======  User Set Variable in This Program ****
  1366.  
  1367. SELECT CASE Sdata.vid
  1368.     CASE IS = 0                                  'Monochrome MDA or Herc
  1369.         pc.fg = 7: pc.bg = 0: pc.bt = 15: pc.wf = 7: pc.wb = 0
  1370.         pc.mf = 0: pc.mb = 7: pc.hk = 15
  1371.     CASE IS = -1, -2, -3                         'CGA, EGA, VGA Mono (OK for MDA)
  1372.         pc.fg = 7: pc.bg = 0: pc.bt = 15: pc.wf = 0: pc.wb = 7
  1373.         pc.mf = 0: pc.mb = 7: pc.hk = 15
  1374.     CASE IS = 1, 2, 3                            'CGA, EGA, VGA Color.  Can separate 1-3 as desired.
  1375.     'PALETTE 1, 24  'Blue-Gray            Optional VGA/EGA text/window backgrounds
  1376.     'PALETTE 1, 16  'Dark Green           vs Base Case default colors.  Can use 32, 48 also
  1377.     'PALETTE 1, 8   'Dark Blue/Black      (every 8).
  1378.     'PALETTE 1, 40  'Dark Purple/Black
  1379.     'PALETTE 1, 56  'Gray
  1380.     pc.fg = 7: pc.bg = 1: pc.bt = 14: pc.wf = 0: pc.wb = 7  'Base Case - W
  1381.     pc.mf = 0: pc.mb = 7: pc.hk = 4                         '(color white text)
  1382.   
  1383.     'pc.fg = 0: pc.bg = 15: pc.bt = 1: pc.wf = 7: pc.wb = 1   'Base Case - B
  1384.     'pc.mf = 0: pc.mb = 3: pc.hk = 15                        '(color black text)
  1385.   
  1386.     'PALETTE 6, 56: PALETTE 1, 8                             'VGA Option 1 - B
  1387.     'pc.fg = 0: pc.bg = 6: pc.bt = 1: pc.wf = 7: pc.wb = 1
  1388.     'pc.mf = 1: pc.mb = 7: pc.hk = 15
  1389.   
  1390.     'PALETTE 6, 56: PALETTE 1, 8                             'VGA Option 2 - W
  1391.     'pc.fg = 7: pc.bg = 6: pc.bt = 1: pc.wf = 1: pc.wb = 7
  1392.     'pc.mf = 0: pc.mb = 7: pc.hk = 15
  1393. END SELECT
  1394.  
  1395. END SUB
  1396.  
  1397. SUB StrngBar (Row, Text$) STATIC
  1398.  
  1399. 'String Bar generator for single row menus or text.
  1400. 'Can display message related to user action or other I/O.
  1401. 'Print text in menu .mf color on Row with .mb background color across Row.
  1402. ' Note: By modifying AKMnuRead DATA input and AKMnuCtrl to call on a sequence
  1403. ' of strings, you can display a help descriptor at the bottom of the screen
  1404. ' for each menu item using StrngBar.
  1405.  
  1406. COLOR pc.mf, pc.mb
  1407. LOCATE Row, 1, 0
  1408. PRINT Text$; TAB(80); " ";
  1409. COLOR pc.fg, pc.bg
  1410.  
  1411. END SUB
  1412.  
  1413.