home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / PROGRAM / BASIC / POWBASIC / LIBRARY3 / APLIB.ZIP / HBDEMO.BAS < prev    next >
BASIC Source File  |  1990-11-24  |  64KB  |  1,776 lines
  1.  
  2. '
  3. '             ╔═════════════════════════════════════════════╗
  4. '             ║                                             ║
  5. '             ║                                             ║
  6. '             ║    THE NEW HB ALL-PURPOSE LIBRARY DEMO      ║
  7. '             ║                                             ║
  8. '             ║                                             ║
  9. '             ║        FOR POWER-BASIC PROGRAMMERS          ║
  10. '             ║                                             ║
  11. '             ║                                             ║
  12. '             ║            SPRING / SUMMER 1990             ║
  13. '             ║                                             ║
  14. '             ╚═════════════════════════════════════════════╝
  15. '                                                  ┌─────────────────────────┐
  16. '                                                  │ TO CREATE THIS DEMO OF  │
  17. '                 L O O K  =============== >>>>    │ THE APLIB ROUTINES JUST │
  18. '                            :)                    │ TYPE "makedemo" FROM    │
  19. '                                                  │ THE COMMAND LINE !      │
  20. '                                                  └─────────────────────────┘
  21. '
  22. '              Version 2.00002     //    NOVEMBER '90
  23.  
  24. '                9-16-90 fixed a bit (mostly so it'll work
  25. '                with the upcoming Power Basic version 2.10)
  26. '
  27. '               11-90: Incorporating some suggested improvements
  28. '               and a 3 fixes into FENTRY-U. The window preprocessors
  29. '               now both compile under PB -- one of them hadn't
  30. '               been updated from the TB 1.1 version when I first
  31. '               uploaded this suite. Oops!
  32.  
  33. '               Someone also noted that APLQREF.BAS won't compile.
  34. '               I never thought it would. It's a Quick Reference
  35. '               guide I made up! It has a .BAS extension only so it
  36. '               will come up when I press F3 + CR from PB and get the
  37. '               file select menu; that way I can jump to it for help!
  38.  
  39. '               MORE FIXES: Bulletproofing of QBox () and BOXMESSAGE ()
  40. '                           Menu selection to test box routines
  41. '                           Improved RotaDate -- the user can either use the
  42. '                           arrow keys as before or just type the 4- or
  43. '                           6-digit date (1124 or 112490) directly. Thanks
  44. '                           to Al Musella for the idea.
  45. '                           Insert status in entry fields now a Global var.
  46. '                                (so it stays set from field to field)
  47. '                           Improved PWW & SWW
  48.  
  49. '               NEW ROUTINE: FASTPHONE ()  -- much better than ENTERPHONE.
  50. '                               (I keep forgetting most people can TYPE !!)
  51. '
  52. '               And -- I know I've made more improvements, undocumented,
  53. '                      as I continue to hack away at my office DBMS (which
  54. '                      is getting quite GOOD, pardon me saying so!)
  55. '
  56. '                                                  --   Howard,  11-24-90
  57.  
  58.  
  59. ' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. '
  61. '   This is my custom routines library, a set of procedures etc. that I have
  62. '   written over a few years time, mostly for use in database programs. Also
  63. '   I include a do-nothing program intended for demonstration and
  64. '   development of the functions in the library.
  65. '
  66. '   FEATURES:
  67. '    ------
  68. '
  69. '      MAIN MENUS ACROSS TOP OF SCREEN AND PULLDOWN SUBMENUS -- WITH
  70. '        STANDARD KEYBOARD AND MOUSE CONTROL
  71. '
  72. '      POP UP AND VANISH MENUS AND DIALOG BOXES, ANYWHERE ON THE SCREEN
  73. '
  74. '      INPUT ROUTINES FOR TEXT FIELDS, NUMBERS, DATES ETC. W/ FULL EDITING --
  75. '
  76. '      POP-UP DATA ENTRY WINDOWS  -- CURSOR OR TAB BACK AND FORTH FROM
  77. '        FIELD TO FIELD
  78. '
  79. '      GET DISK, DIRECTORY AND SYSTEM INFO DIRECTLY FROM DOS
  80. '
  81. '      ALL IN BASIC FOR RELIABILITY AND EASY MAINTENENACE
  82. '
  83. '      NOW USES UNITS, SAVES SCREENS DIRECTLY TO MEMORY
  84. '        (USED TO NEED A RAM-DISK, BUT NO MORE)
  85. '
  86. '
  87. '      Your feedback is welcomed -- write to 2097 7th St. in
  88. '      Oakland, Ca. 94607 --  or via the CompuServe PCVENB
  89. '      Forum (# 71121,776), or MOE in the Bay Area.
  90. '
  91. '      -- Howard Ballinger
  92. '
  93.                            $COMPILE EXE
  94.                            $LIB LPT ON,_
  95.                                 COM OFF, GRAPH OFF, FULLFLOAT OFF, IPRINT OFF
  96.                            $STACK 3072
  97.                            $ERROR ALL ON
  98.  
  99.  %ScrnStackSize = 12
  100.  
  101. '   Correct order seems to be: DIM Statements, $LINK statements,
  102. '                                            then PUBLIC statements. WORKS !!
  103.  
  104.                            $INCLUDE "APLIB-H.BAS"
  105.  
  106.                            $LINK "INIT-U.PBU"
  107.                            $LINK "FENTRY-U.PBU"
  108.                            $LINK "FIGDAT-U.PBU"
  109.                            $LINK "BOXES-U.PBU"
  110.                            $LINK "MENUS-U.PBU"
  111.                            $LINK "MISC-U.PBU"
  112.  
  113.                            $INCLUDE "HBDEMO.PV"
  114.  
  115. '                                        The *.PV files are lists of all the
  116. '                                        public variables in a program's units.
  117. '                                        Any time you change the EXTERNAL
  118. '                                        variables in your units, run
  119. '                                        PUBVARS.EXE and you will get a fresh,
  120. '                                        sorted list to include in the main
  121. '                                        file, like this.
  122.  
  123.  
  124.  ButtonsActive = %False '             (button feature used only in MC-MENU.BAS)
  125.  LocalAreaCode$ = "415"
  126.  Item% = 101 '                           (starting # for demo checkbook entries)
  127.  
  128.  CALL Initialize (%LQ2500) '              see INIT-U.BAS for other sets of
  129. '                                         printer codes you can select. (New!)
  130.  ON ERROR GOTO Oops
  131.  
  132. '     =============================================== TITLE SCREEN
  133.  GOSUB SetColors
  134.  COLOR ScrColor MOD 16, ScrColor \ 16 '    This breaks down an integer color
  135. '                                          attribute into foreground & backgrd
  136.  CLS
  137.  GOSUB Logo3 '                                print a title in a box on screen
  138.  COLOR ScrColor MOD 16, ScrColor \ 16
  139. '                                              and next, open a Static Window
  140. '                                              (by that I mean one that displays
  141. '                                              some data at run-time but doesn't
  142. '                                              let the user enter any) and
  143. '                                              displays some disk and system
  144. '                                              info in it.
  145.  
  146. ' ===========================================================================
  147.  
  148. '          USE OF THE                            SWW.EXE is a screen generator
  149. '        STATIC WINDOW                           and by processing DEMO.SW
  150. '        PAINT UTILITY                           gives the BASIC statements in
  151. '           SWW.EXE                              these lines to draw window
  152. '                                                and set up its static fields.
  153. '                                                The template files are similar
  154. '                                                to those use to make POPWINDOW
  155. '                                                designs, as described below.
  156. '                                                See OPENDEMO.SW for an example.
  157. ' ===========================================================================
  158.  
  159.                       $INCLUDE "opendemo.inc"
  160.  
  161.  COLOR ScrColor MOD 16, ScrColor \ 16
  162.  LOCATE 24, 41: PRINT "note: use a mouse if you wish. L = yes.";
  163.  
  164.  COLOR BarColor MOD 16, BarColor \ 16
  165.  LOCATE 25,1: CALL ClearLine '        SUB ClearLine erases screen from cursor
  166. '                                     position all the way to rt edge of scrn
  167.  PRINT "     SOUND ON ?? ";
  168.  SoundOn = GetYesOrNo '                 FUNCTION GetYesOrNo simply writes a
  169. '                                       "(y/n)" prompt to the screen and then
  170. '                                       awaits the user's pleasure. It is case
  171. '                                       insensitive & also Mousable. (L = Yes.)
  172.  GOSUB SetBeeps
  173.  If SoundOn THEN PLAY ArribaBeep$
  174.  Choice = 256 '                                   We don't want Choice, the
  175. '                                                 menu return value, to be 0 at
  176. '                                                 the start. A Choice value of
  177. '                                                 0 is used for a specific
  178. '                                                 purpose: it means [Esc] was
  179. '                                                 pressed in reponse to a
  180. '                                                 pull-down menu.
  181.  
  182.  
  183. ' ==================================== PRINT MAIN MENU -- A BAR ACROSS TOP
  184.  
  185. MainMenu:
  186.  GOSUB SetColors '                                 set colors based on defaults
  187.  COLOR ScrColor MOD 16, ScrColor \ 16 '               or command line switches.
  188.  CLS
  189.  NextScrn2Pop = 1 '                          Reset the screen stack pointer
  190. '                                            to 1. At this point the
  191. '                                            next screen we "push" (save) will
  192. '                                            be numbered 2 (I'm not using an 0)
  193.  
  194.  IF Choice > 0 THEN '  unless user has just backed out of a menu w/o selecting,
  195.    TChoice = 1 '                  the return variable Choice will be > 0 and
  196.    GOSUB Logo2 '                     the main menu will be reset to choice #1
  197.  END IF
  198.  TLine$ = " HB's POW-Bas Routines Library: the Demo " '            menu title
  199.  
  200.  RESTORE MainMenu
  201.  If SoundOn THEN PLAY LookitBeep$
  202. ' =============================================================================
  203. '
  204. '       How to use "TOPMENU ()" -- The Horizontal Main Menu Procedure --
  205. '        -----------------------------------------------------------
  206. '
  207. '    This procedure writes a list of choices across the top of the screen and
  208. '    allows the user to select from them by one of three methods: (1) Press the
  209. '    first letter of the desired choice (note that you can't have two choices
  210. '    starting with the same letter!) or (2) use the cursor arrows to highlight
  211. '    your choice and then press Enter (CR), or (3) if you have a Furry Friend,
  212. '    just click on your choice with the left button. (This is pretty much the
  213. '    way people expect a menu to behave!)
  214. '
  215. '    Set it up with a DATA list of selection titles like the one following --
  216. '    follow w/ DATA END; don't forget to RESTORE to the label above the list.
  217. '    you can use less than a three line menu (to save screen space) but
  218. '    frankly I haven't used 2-line or 1-line TOPMENU's enough to even know
  219. '    whether they have bugs, so just use 3 for now. T$ should be the menu
  220. '    title if you want one, and after the CALL returns, will be set to the
  221. '    string chosen by the user or "HELP!" if F1 pressed. Mostly I just branch
  222. '    the program on the basis of TChoice, an integer showing which selection
  223. '    was made.
  224. ' =============================================================================
  225.  
  226.  DATA "POPWINDOW DEMO","FILES","MENUS & BOXES","OTHER DEMOS","QUIT/CONFIG"
  227.  DATA END
  228.  NumberOfLines = 3
  229.  DO
  230.  
  231.    CALL TOPMENU (NumberOfLines,TChoice,T$)
  232.  
  233.    ' if T$ = "HELP!"a suitable help screen may be added here ...
  234.  
  235.  LOOP UNTIL T$ <> "HELP!"
  236.  CALL SCREENPUSH '                      save this screen to memory ...
  237.  
  238.  MainMenuScreen = NextScrn2Pop '          make a note of what number it is ...
  239.  
  240.  ON TChoice GOTO OpenEntryWindow, FileSubmenu, MenuDemo, MiscDemos, QuitSubMenu
  241.  
  242.  
  243. '  ------------------ MAIN MENU CHOICE # 2: FILE SUBMENU ------------------
  244.  
  245. FileSubmenu:
  246. ' ============================================================================
  247.  
  248. ' Notes:              *** HOW TO USE: SUPERMENU () ***
  249. '                           ===================
  250. '
  251. 'Syntax:
  252. 'CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  253. '
  254. '
  255. '        MENU SETUP: THE MenuData$ ARRAY:
  256. '           Each choice on your menu is represented by one string element in
  257. '           this array. The decription of each choice -- for example, "LOAD",
  258. '           will start with the third character of this string. If you are
  259. '           specifying the hot-key for each choice put it into the first
  260. '           character -- set MenuData$ (1) as something like "L LOAD". To let
  261. '           the software number or letter the items in order for you, set
  262. '           MenuData$ as just "  LOAD". (If there are <10 items, numbers
  263. '           are used rather than letters.) After the last menu item, you
  264. '           must set the next array element as "END".
  265. '        PASSING HELP LINES TO MENU: Set MenuHelpLine$() to contain lines (up
  266. '           to 80 chr long) to appear at screen bottom whenever the
  267. '           corresponding menu choice is highlighted.
  268. '        POSITION OF MENU ONSCREEN ETC.: MenuRight moves it right or left --
  269. '           MenuDown moves it -- you guessed it! 0,0 is top center. Errors are
  270. '           trapped. Vertical centering is gotten by setting MenuDown = 25.
  271. '           Usually set Choice = 1.  Title$ is title of menu.
  272.  
  273. ' *** AFTER MENU ROUTINE: Choice will hold the choice #. Title$ reset to "".
  274. '           MKeyPressed$ = the actual key used (if L. Mousebutton was used it
  275. '           simulates the CR key, i.e. CHR$(13)) -- or if [ESC] or a legal
  276. '           function key was pressed it contains "ESC", "PgDn", "PgUp", "F1",
  277. '           or "F2". (Right Mousebutton = "ESC".)
  278. ' ============================================================================
  279.  
  280.  MenuData$(1) = "F Directory"
  281.  MenuData$(2) = "V View .BAS"
  282.  MenuData$(3) = "D View .DOC"
  283.  MenuData$(4) = "C Copy files"
  284.  MenuData$(5) = "O Shell to DOS"
  285.  MenuData$(6) = "END"
  286.  MenuHelpLine$ (1) =_
  287.       "Using CALL DirFirst & DirNext (SUB's that get info direct from DOS)"
  288.  MenuHelpLine$ (2) = "this lets you read the source file HBDEMO.BAS"
  289.  MenuHelpLine$ (3) =_
  290.       "this lets you display the documentation accompanying HBLib"
  291.  MenuHelpLine$ (4) = "here a dummy function"
  292.  MenuHelpLine$ (5) = "this works -- if it can find COMMAND.COM & load it ..."
  293.  
  294.  Title$ = ""
  295.  Choice = 1
  296.  PullDown = %Yes '                  Make this a pulldown supermenu ...
  297.  UseRArrow = %Yes '                 We want to be able to drag it either
  298.  UseLArrow = %Yes '                   rt or left with arrow keys or rodent ...
  299.  MenuRight = -15
  300.  MenuDown = 2
  301.  
  302.    CALL SUPERMENU (MenuData$(), MenuRight, MenuDown,_
  303.                                                 Choice, Title$, KeyPressed)
  304.  
  305.  DECR NextScrn2Pop '                   we won't need to pop the previous screen
  306.  IF Choice = 0 THEN MainMenu
  307.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO OpenEntryWindow
  308.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO MenuDemo
  309.  SELECT CASE LEFT$ (MenuData$ (Choice), 1)
  310.    CASE "F"
  311.      GOSUB Directory
  312.      GOTO MainMenu
  313.    CASE "V", "D"
  314.     If SoundOn THEN PLAY LookitBeep$
  315.     IF ColorDisplay THEN COLOR %Wht, %Vlt ELSE COLOR %Gry, %Blk
  316.      CLS
  317.      IF Choice = 3 THEN File2View$ ="AP-LIB.DOC" ELSE File2View$ = "HBDEMO.BAS"
  318.      IF EXIST (File2View$) THEN '              uses function EXIST () ...
  319.        TxtFile = FREEFILE '                    gets an available handle # ...
  320.        OPEN File2View$  FOR INPUT AS #TxtFile
  321.        Ln = 0
  322.        DO UNTIL EOF (TxtFile) OR FileError '             and views the file.
  323.          LINE INPUT #1, L$
  324.          INCR Ln
  325.          PRINT LEFT$ (L$, 79)
  326.          IF CSRLIN = 23 THEN
  327.            Color %Blu, %Cyn
  328.            PRINT STRING$ (80, 205);
  329.            CALL ClearLine
  330.            PRINT "  WORLD'S MOST PRIMITIVE FILE VIEWER:  File ";
  331.            PRINT File2View$; ",  LINE "; Ln-21;
  332.            LOCATE 25,1
  333.            CALL ClearLine
  334.            PRINT " PRESS [ESC] TO EXIT, [PG-UP] TO GO BACK TO LINE 1, ";
  335.            PRINT "ANY OTHER KEY TO GO ON";
  336.            Color %Wht, %Vlt
  337.            DO: LOOP UNTIL INSTAT
  338.            K$ = INKEY$
  339.            IF K$ = CHR$ (27) THEN EXIT LOOP
  340.            IF K$ = CHR$ (0) + CHR$ (&H49) THEN
  341.              If SoundOn THEN PLAY TinyBeep$
  342.              CLOSE #TxtFile
  343.              OPEN File2View$  FOR INPUT AS #TxtFile
  344.              Ln = 0
  345.            END IF
  346.            FOR N = 1 TO 23: LOCATE N, 1: CALL ClearLine: NEXT: LOCATE 1,1
  347.          END IF
  348.        LOOP
  349.        If SoundOn THEN PLAY ArribaBeep$
  350.        CLOSE #1
  351.      ELSE
  352.        CALL QBox (10,30,1,"DID NOT FIND FILE " + File2View$, 0)
  353. '                                   QBox was written to put little dialog boxes
  354. '                                   onscreen -- but it turns out to very handy
  355. '                                   as a message box as well. This will print
  356. '                                   a box at position 19,13 with this string
  357. '                                   in it and an answer field length of zero
  358.  
  359.        CALL PressAKey '             Little box says Press Any Key ... if mouse
  360.      END IF '                       present it also suggests a click.
  361.      EXIT SELECT
  362.    CASE "O"
  363.      If SoundOn THEN PLAY LookitBeep$
  364.      IF ColorDisplay THEN COLOR %Ylo, %Red ELSE COLOR %Blk, %Gry
  365.      CLS
  366.      LOCATE 2,12: PRINT "TYPE `EXIT' TO RETURN TO PROGRAM"
  367.      SHELL
  368.      GOTO MainMenu
  369.    CASE ELSE
  370.      GOTO FakeFunction
  371.  END SELECT
  372.  GOTO MainMenu
  373.  
  374. '  -------------------- MAIN MENU CHOICE #3: MENU DEMOS ----------------
  375.  
  376. MenuDemo:
  377.  
  378.  
  379.  MenuData$ (1) = "   Demo of MESSAGEBOX"
  380.  MenuData$ (2) = "   Demo of QBOX"
  381.  MenuData$ (3) = "   Demo of SUPERMENU"
  382.  MenuData$ (4) = "   Hundred Items Menu"
  383.  MenuData$ (5) = "END"
  384.  Choice = 1
  385.  PullDown = %Yes
  386.  UseRArrow = %Yes
  387.  UseLArrow = %Yes
  388.  CALL SUPERMENU (MenuData$ (), 0, 2, Choice, "", KeyPressed)
  389.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO FileSubMenu
  390.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO MiscDemos
  391.  ON Choice GOSUB MessageBoxTest, QBoxTest, MoveAMenuII, HundredItemsMenu
  392. '           NOTE: if [Esc] was pressed, Choice = 0 and there's no GOSUB at all.
  393.  GOTO MainMenu
  394.  
  395.  
  396. '   ==================== MAIN MENU CHOICE # 4 -- MISC. SUBMENU
  397.  
  398. MiscDemos:
  399.                                ' set up menu lines & help lines ...
  400.  
  401.  MenuData$ (1) = "  ENTRY MODES" '            note that for this menu I've
  402.  MenuData$ (2) = "  DATE ARITHMETIC" '        left two spaces in front of
  403.  MenuData$ (3) = "  BEEPS" '                  each choice. SUPERMENU will
  404.  MenuData$ (4) = "  END" '                    number them (or letter if > 9)
  405.  
  406.  MenuHelpLine$ (1) = "many different types of line entries demonstrated"
  407.  MenuHelpLine$ (2) = "the all-knowing machine will tell you your age ..."
  408.  MenuHelpLine$ (3) =_
  409.      "this is a test-bed to invent, hear and save your own favorite Beeps ..."
  410.  
  411.  MenuRight = 18              ' locate menu ...
  412.  MenuDown = 2
  413.  Choice = 1                 ' start with first item highlighted ...
  414.  Title$ = ""                 ' no title ...
  415.  Choice = 1
  416.  UseRArrow = %Yes
  417.  UseLArrow = %Yes
  418.  PullDown = %Yes
  419.  
  420.  CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  421.  
  422.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO MenuDemo
  423.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO QuitSubMenu
  424.  
  425.  DECR NextScrn2Pop '                   we won't need to pop the previous screen
  426.  ON Choice GOSUB EnterDemo, DateTest, BeepTest
  427.  GOTO MainMenu
  428.  
  429.  
  430. QuitSubMenu: '  ====================== MAIN MENU CHOICE #5: QUIT
  431.  
  432.  MenuData$ (1) = "Y Exit to DOS"
  433.  
  434.  IF SoundOn THEN
  435.    MenuData$ (2) = "S Sound Off"
  436.  ELSE
  437.    MenuData$ (2) = "S Sound On"
  438.  END IF
  439.  
  440.  MenuData$ (3) = "E Fake ERROR"
  441.  MenuData$ (4) = "N Cancel"
  442.  MenuData$ (5) = "END"
  443.  
  444.  MenuHelpLine$ (3) = "force an error just to see the error handling routine"
  445.  MenuHelpLine$ (4) = "don't quit after all ... "
  446.  
  447.  Title$ = ""
  448.  Choice = 1
  449.  PullDown = %Yes
  450.  UseLArrow = %Yes
  451.  CALL SUPERMENU (MenuData$(), 40, 2, Choice, Title$, KeyPressed)
  452.  IF KeyPressed = %LArrow THEN GOSUB MZap: GOTO MiscDemos
  453.  
  454.  If SoundOn THEN PLAY LookitBeep$
  455.  
  456.  
  457.  IF CHOICE = 0 THEN
  458.    CALL SCREENPOP
  459.    GOTO MainMenu
  460.  ELSE
  461.    IF LEFT$ (MenuData$ (Choice), 1) <> "E" THEN COLOR 0,0:CLS:DECR NextScrn2Pop
  462.  END IF
  463.  IF Choice <> 0 THEN OldChoice = 1
  464.  
  465.  SELECT CASE LEFT$ (MenuData$ (Choice), 1)
  466.    CASE "Y"
  467. LastScrn:
  468.      CLS
  469.      CALL CloseFiles '        Take care of writing database files back if any...
  470.      DELAY 0.5
  471.      ON ERROR GOTO HarmlessError
  472.      CALL RestoreDOSScreen '      restore screen that was there to begin with;
  473.      LOCATE ,,0
  474.  
  475. '                                   write a boxed Farewell Message on top
  476. '                                   of the restored screen -- really
  477. '                                   impress 'em!
  478.  
  479.      DATA "Thank you for using", "the HB Library DEMO",""
  480.      DATA Program ends., Press something.
  481.      DATA END
  482. '                                         ===================================
  483. '                                         USING BOXMESSAGE ():
  484. '                                         You need a DATA list like this;
  485. '                                         use a RESTORE statement so the
  486. '                                         runtime system can find it;
  487.      RESTORE LastScrn '                   set the margin ...
  488.      Margin = 1 '                         set CornerLin & CornerCol or use
  489.      If SoundOn THEN PLAY TaskBeep$ '     %Center as we do here to center the
  490.      CALL SCREENPUSH '                    window ... and it's ready.
  491. '                                         ===================================
  492.  
  493.        CALL BOXMESSAGE (%Center, %Center, Margin)
  494.  
  495.      GOSUB ClickOrStrike
  496.      CALL SCREENPOP '               erase the box and return control to DOS.
  497.      LOCATE OrigL, OrigC
  498.      END '                             ================>> EXIT POINT
  499.  
  500.    CASE "S"
  501.      SoundOn = NOT SoundOn
  502.  
  503.    CASE "E"
  504.    ErrorMessage$ = "fake error generated from HBDEMO menus"
  505.     DO
  506.       CALL SCREENPUSH
  507.       EType$ = " "
  508.       CALL QBox_
  509.         (5,10,1,"D for DOS ERROR, P for PRINTER ERROR, O for OTHER ERROR ", 2)
  510.       COLOR FldColor MOD 16, FldColor \ 16
  511.       Opt$ = "AutoCap"
  512.       FieldSize = 1
  513.  
  514.         CALL ENTERSTRING (EType$, FieldSize, Opt$)
  515.  
  516. ' =============================================================================
  517.  
  518. '                How to use SUB ENTERSTRING (Wkg$,FLength,Opt$)
  519. '                  ----------------------------------------
  520.  
  521. '                   This routine provides a field at current corsor loc
  522. '                   for the operator
  523. '                   to enter data into. Wkg$ is the current value of the field.
  524. '                   FLength = length of field. Opt$ may be "" or may hold
  525. '                   the strings "Cap" for all uppercase, "Auto" for automatic
  526. '                   entry when full, "UpOut" or "BackOut" if UpArrow or Left/
  527. '                   backspace keys are to be able to end entry. Tab and ShfTab
  528. '                   also work.
  529. '
  530. '        On exiting sub, Opt$ may be reset as Left, Auto, Up, Down, ESC or CR.
  531. '        At any time during string entry the operator can press [CR] or DOWN-
  532. '        ARROW to enter;  [F2] is pressed for Database Function commands
  533. '        (Clear, Find, Next/Prev, View Notes, Save) implemented (see SUB
  534. '        FileFunctions)
  535. '        2-4-89: Now supports: Ins default (in Opt$), ^Y, ^T, and ^Arrow
  536. '                Negative numbers not allowed unless Opt$ includes a "-"
  537. '
  538. '   N.B.: OF COURSE THIS IS JUST A ONE-CHR STRING TO ENTER. I PUT THE DOC
  539. '         BLOCK HERE 'CAUSE IT'S THE  F I R S T  INSTANCE OF THIS CALL. 
  540. '         THERE ARE MANY MORE-TYPICAL EXAMPLES TO FOLLOW ...
  541. ' ===========================================================================
  542.  
  543.       CALL SCREENPOP
  544.     LOOP UNTIL EType$ = "O" OR EType$ = "P" OR EType$ = "D" OR Opt$ = "ESC"
  545.     ON ERROR GOTO Oops
  546.     IF Opt$ = "ESC" THEN MainMenu
  547.     SELECT CASE EType$
  548.       CASE "O"
  549.         ERROR 5
  550.       CASE "D"
  551.         JustDemonstratingOops = %True
  552.         ERROR 53
  553.         EXIT SELECT
  554.       CASE ELSE
  555.         ERROR 27
  556.     END SELECT
  557.   END SELECT
  558.   GOTO MainMenu '                here end the various pulldown menus. Next
  559. '                                come major routines ... Starting with
  560. '                                OpenEntryWindow (lifted, as you might guess,
  561. '                                from my personal custom Checkbook Program).
  562.  
  563. OpenEntryWindow:
  564.  
  565. '===============================================================================
  566. '    ABOUT POPWINDOWS:
  567. '    Here's how to create a window for data entry like the one demonstrated
  568. '    here: (1) Create a plain-ASCII template file for your window and name
  569. '              it like WHATEVER.PW (See PWDEMO.PW for a sample).
  570. '          (2) Draw out the top and left side of the window box using the
  571. '              carat (^^^) symbol. Type in the field titles and then use a
  572. '              left bracket ("{") to show where you want each data entry field
  573. '              to start.
  574. '          (3) Under that type a backslash ("\") at the left margin, followed
  575. '              by a list of the following: First your name for the field, then
  576. '              a comma, and then IN QUOTES the mask string you want to use for
  577. '              the data in your field (according to the rules for the
  578. '              PRINT USING statement).
  579. '          (4) Now you need to use a utility PWW.EXE. Compile PWW.BAS to create
  580. '              it if you need to. Type PWW, followed optionally by the name
  581. '              of your POPWINDOW file (with or without its .PW extension). If
  582. '              you haven't screwed up, an INClude file will be created just
  583. '              like PWDEMO.INC, to include (or read into) your program !!
  584. '===============================================================================
  585.  
  586.  RESTORE OpenEntryWindow
  587.  
  588.                           $INCLUDE "PWDEMO.INC" '      contains DATA statements
  589. '                                                      to define the window.
  590.    CALL POPWINDOW
  591.  
  592.  If SoundOn THEN PLAY LookItBeep$
  593.  
  594. '===============================================================================
  595. '   OK, now what's happened ?? First off, your data entry window has been
  596. '   opened (drawn) on the screen, using the attribute BoxColor; and the blank
  597. '   data fields have been added using FieldColor. Also a table has been created
  598. '   in memory consisting of several arrays to instantly reset the cursor to
  599. '   any of the fields in the window and find which mask string to use on that
  600. '   particular field. This job is done by PWSetUp (). Read on ...
  601. '===============================================================================
  602.  
  603. '                    ____________________________
  604.  
  605.  NewRec = %True
  606.  
  607. BeginEntry:
  608.  
  609. GetTypeOfTransaction:
  610.  
  611.  LOCATE 25,1: CALL ClearLine
  612.  LOCATE 24,1: CALL ClearLine: PRINT Esc2Q$;
  613.  
  614. '                                     create a SUPERMENU of these choices ...
  615.  MenuData$ (1) = "C CHECK"
  616.  MenuData$ (2) = "D DEPOSIT"
  617.  MenuData$ (3) = "A AUTO DEBIT"
  618.  MenuData$ (4) = "T TRANSFER"
  619.  MenuData$ (5) = "J ADJUSTMENT"
  620.  MenuData$ (6) = "END"
  621.  
  622.  CALL SCREENPUSH
  623.  
  624.  Choice = 1                 ' start with first item highlighted ...
  625.  Title$ = ""                 ' no title ...
  626.  Choice = 1
  627.  UseRArrow = %Yes
  628.  PullDown = %Yes
  629.  MenuDown = 2
  630.  MenuRight = -40
  631.  CALL SUPERMENU (MenuData$(), MenuRight, MenuDown, Choice, Title$, KeyPressed)
  632.  
  633.  IF KeyPressed = %RArrow THEN GOSUB MZap: GOTO FileSubMenu
  634.  
  635.  IF Choice = 0 THEN
  636.    COLOR %Vlt, %Vlt: CLS
  637.    GOTO MainMenu
  638.  END IF
  639.  
  640. TypeOfTransferMenu:
  641.  
  642.  IF Choice = 4 THEN
  643.    DATA FROM CHECKING TO SAVINGS,
  644.    DATA FROM SAVINGS TO CHECKING,
  645.    DATA END
  646.                                           ' this is a POPMENU, the predecessor
  647.                                           ' of SUPERMENU. Now SUB POPMENU ()
  648.                                           ' is just a wrapper for SUPERMENU
  649.    RESTORE TypeOfTransferMenu             ' so I don't have to convert all my
  650.    MLine$ = "type of transfer"            ' old code. It uses READ intead of
  651.    Choice = 1                             ' passing an array.
  652.  
  653.      CALL POPMENU ("1", -12, 9, Choice, MLine$, Dum$)
  654.  
  655.    CALL SCREENPOP
  656.    IF Choice = 0 THEN GOTO BeginEntry
  657.    IF ColorDisplay THEN COLOR %Ylo,%Red
  658.    IF Choice = 1 THEN TransactionType$ = "TRANSFER C-S" ELSE_
  659.                                  TransactionType$ = "TRANSFER S-C"
  660.  ELSE
  661.    CALL SCREENPOP
  662.    TransactionType$ = MID$ (MenuData$ (Choice), 3)
  663.  END IF
  664.  
  665. '===============================================================================
  666. '  OK, gentle hackfriend -- don't panic! What happens in the first data entry
  667. '  field in this dummy checkbook program, is that two successive menus are used
  668. '  as "pick lists" to get the data rather than having the user type it in. (If
  669. '  this isn't clear, try it out -- run HBDEMO.EXE -- and it should make
  670. '  a modicum of sense.)
  671. '
  672. '  So here is that PWSetUp () call. It searches out a field name in the table
  673. '  I mentioned above to match the field description string (FldN$)
  674. '===============================================================================
  675.  
  676.  FldN$ = "TYPE OF TRANSACTION"
  677.  COLOR FldColor MOD 16, FldColor \ 16
  678.  KeyField = %False
  679.  
  680.  CALL PWSetUp (FldN$,Tbl%)
  681. '                                             now the cursor should be in
  682. '                                             the right place and Tbl%
  683. '                                             should be the right item # in
  684. '                                             the array. Let's try it & see ...
  685.  
  686.  PRINT USING FieldMask$(Tbl%); TransactionType$
  687. '                _______________________________________      WOW !!! NeatO !!
  688.  
  689. CheckNumberEntry:
  690.  
  691.  COLOR %Blk, %Blk: LOCATE 23,1: CALL ClearLine
  692.  COLOR FldColor MOD 16, FldColor \ 16
  693.  LOCATE 25,1: CALL ClearLine: PRINT "    "; F2Fun$; Up2B$; Esc2Q$;
  694.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  695.  FldN$ = "NUMBER": A# = Item%
  696.  CALL PWSetUp (FldN$,Tbl%)
  697.  
  698.  IF RTRIM$ (TransactionType$) = "CHECK" THEN
  699.    KeyField = %True '                    this clues in the FileFunctions menu
  700.    Opt$ = "F1 F2 UpOut"
  701. '                                                  ENTERNUMBER () works a lot
  702.      CALL ENTERNUMBER (A#,"####",Opt$) '           like ENTERSTRING () except
  703. '                                                  you specify a Mask String
  704. '                                                  so it can do PRINT USING.
  705.  
  706.    IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO CheckNumberEntry
  707.    IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO GetTypeOfTransaction
  708.    Item% = A#
  709.    GOSUB F2orEscHandler
  710.  ELSE
  711.    PRINT " -- "
  712.  END IF
  713.  
  714. DateEntry:
  715.  
  716.  LOCATE 25,1: CALL ClearLine: PRINT "    "; Up2B$; Esc2Q$;
  717.  BXScreenSaved = %False
  718.  KeyField = %True
  719.  FldN$ = "DATE"
  720.  CALL PWSetUp (FldN$,Tbl%)
  721.  L = CSRLIN: C = POS
  722.  IF DateLastUsed$ = "" OR_
  723.                     FigDate& (DateLastUsed$) = 0 THEN DateLastUsed$ = GetDate$
  724.  
  725.  IF Opt$ <> "Up" AND Opt$ <> "ShfTab" OR_
  726.          FigDate& (TransactionDate$) = 0 THEN TransactionDate$ = DateLastUsed$
  727.  
  728.  Opt$ = "N/AOK"
  729.  
  730.    CALL RotaDate (TransactionDate$,Opt$)
  731.  
  732. ' =========================================================================
  733. '        ROTADATE: This is the date entry routine where you can use the cursor
  734. '        keys to go ahead or back to the date you want. If you want you can
  735. '        also key in the date in the usual way ...
  736. ' =========================================================================
  737.  
  738.    IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO DateEntry
  739. '                                                     FigDate returns a 0 if
  740. ' LOCATE L,C
  741. ' PRINT TransactionDate$
  742.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO CheckNumberEntry
  743.  GOSUB F2orEscHandler
  744.  DateLastUsed$ = TransactionDate$
  745.  
  746. ToFromWhomEntry:
  747.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  748.  LOCATE 25,1: CALL ClearLine: PRINT "    "; F2Fun$; Up2B$; Esc2Q$;
  749.  KeyField = %True
  750.  FldN$ = "TO/FROM"
  751.  CALL PWSetUp (FldN$,Tbl%)
  752.  X = CSRLIN: Y = POS
  753.  Opt$ = "F1F2UpOutCaps"
  754.  
  755.  IF RTRIM$ (TransactionType$) = "AUTO DEBIT" THEN
  756.    ToFrom$ = "CASH FROM A.T.M."
  757.  ELSE
  758.    ToFrom$ = ""
  759.  END IF
  760.  
  761.    CALL ENTERSTRING (ToFrom$,LEN(FieldMask$(Tbl%)),Opt$)
  762.  
  763.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO ToFromWhomEntry
  764.  IF Opt$ = "Up" OR Opt$ = "ShfTab" THEN GOTO DateEntry
  765.  GOSUB F2orEscHandler
  766.  KeyField = %False
  767.  IF Opt$ = "Up" THEN
  768.    GOTO DateEntry
  769.  ELSE
  770.    ToFrom$ = A$
  771.  END IF
  772.  
  773. EntAmt:
  774.  COLOR Ink2, Paper2
  775.  COLOR FldColor MOD 16, FldColor \ 16
  776.  LOCATE 25,1: CALL ClearLine: PRINT Up2B$; Esc2Q$;
  777.  FldN$ = "AMOUNT": Amt# = 0
  778.  CALL PWSetUp (FldN$,Tbl%)
  779.  Opt$ = "F2UpOut - "
  780.  
  781.    CALL ENTERNUMBER (Amt#, FieldMask$(Tbl%), Opt$)
  782.  
  783.  IAmtCents& = 100 * Amt#
  784.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO ToFromWhomEntry
  785.  GOSUB F2orEscHandler
  786.  
  787. SaveRecord:
  788.  
  789.  COLOR %Wht,%Blk: LOCATE 24,1: CALL ClearLine: LOCATE 25,1: CALL ClearLine
  790.  LOCATE 24,9: PRINT "Note: THERE IS NO REAL SAVE RECORD FUNCTION -- DUMMY ONLY";
  791.  CALL SCREENPUSH
  792.  CALL QBox (19,30,1,"SAVE RECORD ?? ",3)
  793.  If SoundOn THEN PLAY LookitBeep$
  794.  CALL ENTERYESNO (Confirm) '                      query if save to be done ...
  795.  CALL SCREENPOP
  796.  IF Confirm THEN
  797.    If SoundOn THEN PLAY TaskBeep$
  798.    DELAY 1.6
  799.    IF RTRIM$ (TransactionType$) = "CHECK" THEN INCR Item%
  800.    GOTO MainMenu
  801.  ELSE
  802.    GOTO BeginEntry
  803.  END IF
  804.  
  805.  GOSUB SaveRecord
  806.  
  807.  GOTO OpenEntryWindow
  808. '___________________________________________________________________________
  809.  
  810.  
  811. F2orEscHandler:
  812. '                          Smart menu of choices appropriate to a database,
  813. '                                  such as SAVE, CLEAR, FIND, NEXT etc.
  814.  IF Opt$ = "F2" THEN
  815.   If SoundOn THEN PLAY LookitBeep$
  816.  
  817.   SELECT CASE GetFileFunction$
  818.     CASE "C"
  819.       RETURN OpenEntryWindow
  820.     CASE "F"
  821.       RETURN FakeFunction
  822.     CASE "S"
  823.       RETURN SaveRecord
  824.     CASE ELSE
  825.       RETURN
  826.    END SELECT
  827.  
  828.  ELSEIF Opt$ = "ESC" THEN
  829.     IF NOT IsBlank (TransactionType$) THEN
  830.       CALL SCREENPUSH
  831.       CALL QBox (%Center, %Center, 1,_
  832.             "DO YOU WANT TO CLEAR THIS ENTRY AND RETURN TO MAIN MENU ?? ", 7)
  833.       IF NOT GetYesOrNo THEN CALL SCREENPOP: RETURN
  834.     END IF
  835.     NextScrn2Pop = MainMenuScreen
  836.     CALL SCREENPOP
  837.     RETURN MainMenu
  838.  END IF
  839.  RETURN
  840.  
  841. '    ___________________________________________________________________
  842.  
  843. EnterDemo:
  844.  
  845.  If SoundOn THEN PLAY LookitBeep$
  846.  IF ColorDisplay THEN
  847.    FldColor =  %Ylo + %Background * %Red
  848.    ScrColor =  %Ylo + %Background * %Blk
  849.  END IF
  850.  COLOR %Gry, %Blk
  851.  CLS
  852. '   Code to write Static Window {ENTERDEM} to Screen
  853. '        note: created by StatWindow Writer (SWW) from ENTERDEM.SW
  854.  
  855.  COLOR BoxColor MOD 16, BoxColor \ 16
  856.  LOCATE  2, 9
  857.  PRINT "┌───────────────────────────────────────────────────────────┐"
  858.  LOCATE  3, 9
  859.  PRINT "│        A-P Library Demo : the Data Entry Routines         │";
  860.  LOCATE  4, 9
  861.  PRINT "│                                                           │";
  862.  LOCATE  5, 9
  863.  PRINT "│         (ENTERSTRING, ENTERNUM, ENTERDATE ETC.)           │";
  864.  LOCATE  6, 9
  865.  PRINT "└───────────────────────────────────────────────────────────┘";
  866.  
  867.  COLOR ScrColor MOD 16, ScrColor \ 16
  868.  
  869. '  07-06-1990, 23:46:   end of StatWindow generated code for window {ENTERDEM}
  870.  
  871.  LOCATE 24,1: CALL ClearLine: PRINT EnHelp$;
  872.  LOCATE 25,1: CALL ClearLine: PRINT F1Help$;
  873.  
  874. '    -----------------------   First line: a plain entry, except no lower case:
  875. StartEntries:
  876.  O$ = "DEFAULT ENTRY" '                          the string starts off as this
  877.  LOCATE 7,4: PRINT "REGULAR ENTRY, ALL CAPS w/ DEFAULT: "; ' leave cursor here
  878.  COLOR FldColor MOD 16, FldColor \ 16
  879.  Opt$ = "Caps F1" '                                use all capitals, accept F1
  880.  FLength = 14
  881.  
  882.    CALL ENTERSTRING (O$, FLength, Opt$)
  883.  
  884.  COLOR ScrColor MOD 16, ScrColor \ 16
  885.  LOCATE 7,60: PRINT "Opt$ = ";Opt$;"   " '                    The value of Opt$
  886.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO StartEntries '     on termination of
  887.  IF Opt$ = "ESC" GOTO DoneED '                                SUB ENTER* shows
  888. '                                                             what key was used
  889. '                                                             to exit the sub.
  890.  
  891. ' --------------------------  Next line: a string with Auto-CR when field full:
  892.  
  893.  P$ = "Just keep typing ..."
  894. AutoE:
  895.  LOCATE 9,4: PRINT "ENTRY w/ AUTOMATIC TERMINATION: ";
  896.  COLOR FldColor MOD 16, FldColor \ 16
  897.  Opt$ = "F1 Auto"
  898.  
  899.    CALL ENTERSTRING (P$, 20, Opt$)
  900.  
  901.  COLOR ScrColor MOD 16, ScrColor \ 16
  902.  LOCATE 9,60: PRINT "Opt$ = ";Opt$;"   "
  903.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO AutoE
  904.  IF Opt$ = "ESC" GOTO DoneED
  905.  
  906. ' ------------------------  This time up-arrow, ShfTab or left arrow will exit
  907.  
  908.  LOCATE 25,1: PRINT Up2B$; F1Help$;
  909. UpArrE:
  910.  LOCATE 11,4: PRINT "ENTRY w/ UP-ARROW & BACK-OUT ENABLED: ";
  911.  COLOR FldColor MOD 16, FldColor \ 16
  912.  Opt$ = "F1UpOut BackOut"
  913.  
  914.    CALL ENTERSTRING (Q$, 4, Opt$)
  915.  
  916.  COLOR ScrColor MOD 16, ScrColor \ 16
  917.  LOCATE 11,60: PRINT "Opt$ = ";Opt$;"   "
  918.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO UpArrE
  919.  IF Opt$ = "Up" OR Opt$ = "Left" OR Opt$ = "ShfTab" GOTO AutoE
  920.  IF Opt$ = "ESC" GOTO DoneED
  921.  
  922. ' ----------------------------- Let us not forget the main purpose of
  923. '                               computers, counting beans! Here is money entry:
  924. DollE:
  925.  LOCATE 13, 4: PRINT "DOLLAR AMOUNT ENTRY: ";
  926.  COLOR FldColor MOD 16, FldColor \ 16
  927.  IF Opt$ <> "Up" THEN O# = 0: Opt$ = "F1UpOut"
  928. '                                              Here is ENTERNUMBER ().
  929.    CALL ENTERNUMBER (O#,"$####.##", Opt$) '    Note that the second argument is
  930. '                                              a mask string for PRINT USING.
  931.  COLOR ScrColor MOD 16, ScrColor \ 16
  932.  LOCATE 13,60: PRINT "Opt$ = ";Opt$;"   "
  933.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO DollE
  934.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO UpArrE
  935.  IF Opt$ = "ESC" GOTO DoneED
  936.  
  937. ' ---------------------------- Now let's enter a decimal number.
  938. NumE:
  939.  LOCATE 15, 4: PRINT "NUMERIC ENTRY, 1 DECIMAL: ";
  940.  COLOR FldColor MOD 16, FldColor \ 16
  941.  Opt$ = "F1UpOut"
  942.  IF Opt$ <> "Up" THEN P# = 98.6
  943.  
  944.    CALL ENTERNUMBER (P#,"##.#", Opt$)
  945.  
  946.  COLOR ScrColor MOD 16, ScrColor \ 16
  947.  LOCATE 15,60: PRINT "Opt$ = ";Opt$;"   "
  948.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO NumE
  949.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO DollE
  950.  IF Opt$ = "ESC" GOTO DoneED
  951.  
  952. ' ---------------------------------  ... an SSA # ...
  953. SSNE:
  954.  LOCATE 17,4: PRINT "ENTER A SOCIAL SECURITY #: ";
  955.  COLOR FldColor MOD 16, FldColor \ 16
  956. '         IF Opt$ <> "Up" THEN SSN$ = ""
  957.  Opt$ = "F1UpOut"
  958.  
  959.    CALL ENTERSSN (SSN$, Opt$)
  960.  
  961.  COLOR ScrColor MOD 16, ScrColor \ 16
  962.  LOCATE 17,60: PRINT "Opt$ = ";Opt$;"   "
  963.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO SSNE
  964.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO NumE
  965.  IF Opt$ = "ESC" GOTO DoneED
  966.  
  967. ' ------------------------------------
  968. PhoneE:
  969.  COLOR ScrColor MOD 16, ScrColor \ 16
  970.  LOCATE 19,4: PRINT "ENTER A PHONE #: ";
  971.  COLOR FldColor MOD 16, FldColor \ 16
  972.  IF Opt$ <> "Up" THEN Phone$ = ""
  973.  Opt$ = "F1UpOut"
  974.  
  975.    CALL ENTERPHONE (Phone$, Opt$)
  976.  
  977.  COLOR ScrColor MOD 16, ScrColor \ 16
  978.  LOCATE 19,60: PRINT "Opt$ = ";Opt$;"   "
  979.  IF Opt$ = "HELP!" THEN GOSUB EDHelp: GOTO PhoneE
  980.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO SSNE
  981.  IF Opt$ = "ESC" GOTO DoneED
  982.  
  983. '            =========== NEW !!! ====================
  984.   CALL SCREENPUSH
  985.   CALL QBox (%Center, %Center, 3,_
  986.                "Here's the NEW phone # routine, FASTPHONE", 14)
  987.   CALL FASTPHONE (Phone2$, Opt$)
  988.   DELAY 3
  989.   CALL SCREENPOP
  990.  
  991. ' ------------------------------------------------------- a date & a time ...
  992.  
  993.  IF DateLastUsed$ = "" OR_
  994.                     FigDate& (DateLastUsed$) = 0 THEN DateLastUsed$ = GetDate$
  995.  
  996.  IF Opt$ <> "Up" AND Opt$ <> "ShfTab" OR_
  997.                                    FigDate& (D0$) = 0 THEN D0$ = DateLastUsed$
  998.  
  999.  COLOR ScrColor MOD 16, ScrColor \ 16
  1000.  LOCATE 21,4: PRINT "DATE (use arrows or numbers) ";
  1001.  COLOR FldColor MOD 16, FldColor \ 16
  1002.  Opt$ = "F1 N/Aok"
  1003.  
  1004.    CALL ROTADATE (D0$, Opt$)
  1005.  
  1006.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO PhoneE
  1007.  IF Opt$ = "ESC" GOTO DoneED
  1008.  
  1009.  COLOR ScrColor MOD 16, ScrColor \ 16
  1010.  LOCATE 21,50: PRINT "TIME: ";
  1011.  COLOR FldColor MOD 16, FldColor \ 16
  1012.  T$ = ""
  1013.  Opt$ = "F1UpOut"
  1014.  
  1015.    CALL ENTERTIME (T$, Opt$)
  1016.  
  1017.  IF Opt$ = "Up" OR Opt$ = "ShfTab" GOTO PhoneE
  1018.  
  1019. DoneED:
  1020.  LOCATE 25,1: CALL ClearLine
  1021.  IF NeedDCon THEN
  1022.    PRINT "          hit a key or click your beast to go on ...";
  1023.  ELSE
  1024.    PRINT "          hit a key to go on ...";
  1025.  END IF
  1026.  COLOR ScrColor MOD 16, ScrColor \ 16
  1027.  LOCATE 24,1: CALL ClearLine
  1028.  GOSUB ClickOrStrike
  1029.  GOTO MainMenu
  1030.  
  1031. EDHelp:
  1032.  CALL SCREENPUSH
  1033.  RESTORE EDHelp
  1034.  CALL BOXMESSAGE (0, 0, 1)
  1035.  GOSUB ClickOrStrike
  1036.  CALL SCREENPOP
  1037.  COLOR FldColor MOD 16, FldColor \ 16
  1038.  RETURN
  1039.  
  1040.  DATA "HELP FOR DATA ENTRY ROUTINES FROM HB'S ALL-PURPOSE POWER-BASIC TOOLBOX"
  1041.  DATA ""
  1042.  DATA "There is a space on the screen to type something into. The keyboard"
  1043.  DATA "works the way you'd expect it to -- just like typing on a word"
  1044.  DATA "processing program. If numbers are expected, no other keys will work."
  1045.  DATA ""
  1046.  DATA "You can switch between INSERT MODE (big cursor) OVERSTRIKE MODE w/"
  1047.  DATA "[INSERT] key. The [DELETE] key removes the letter the cursor is on;"
  1048.  DATA "the [BACKSPACE] key also works. Press [ESC] to quit the entry process."
  1049.  DATA ""
  1050.  DATA "If there is something in the field to begin with and you start"
  1051.  DATA "typing something else, the field clears. If the cursor is moved"
  1052.  DATA "around first, that doesn't happen. Use Ctrl-U to undo."
  1053.  DATA ""
  1054.  DATA " Use:   [HOME] key, [END] key, Arrow Keys (Rt & Left) to move cursor   "
  1055.  DATA "        Ctrl-Y to clear the line                                       "
  1056.  DATA "        Ctrl-T to delete one word (to right)                           "
  1057.  DATA "        Ctrl-U to undo (restore original string)                       "
  1058.  DATA "        Ctrl-Rt or Left Arrow, (jumps to beginning of a word)          "
  1059.  DATA ""
  1060.  DATA "See bottom line of screen for more help.                PRESS ANY KEY  "
  1061.  DATA END
  1062.  
  1063. ' ===========================================================================
  1064.  
  1065. DateTest:
  1066.  If SoundOn THEN PLAY LookitBeep$
  1067.  IF ColorDisplay THEN Ink1 = %Blu: Paper1 = %Cyn: Ink2 = %Wht: Paper2 = %Red
  1068.  COLOR Ink1, Paper1: CLS
  1069.  ON KEY (15) GOSUB Done
  1070.  
  1071.  DO
  1072.    DoB$ = ""
  1073.    COLOR Ink1, Paper1
  1074.    LOCATE 5,6: PRINT "Date of Birth :";
  1075.    COLOR Ink2, Paper2
  1076.    Opt$ = ""
  1077.    CALL ENTERDATE (DoB$, Opt$)
  1078.  LOOP UNTIL DoB$ <> "" '                          if date entered not valid,
  1079. '                                                 the result string will be ""
  1080.       COLOR Ink1, Paper1
  1081.       LOCATE 7,6
  1082.       W& = FigDate&(DoB$)
  1083.       IF W& = 0 THEN RETURN MainMenu
  1084.       PRINT "Days from 1-1-1900 (Julioid) = ";
  1085.       COLOR Ink2, Paper2: PRINT W&
  1086.  
  1087.       LOCATE 9,6: COLOR Ink1, Paper1
  1088.       PRINT "Converting Back to Date = ";
  1089.       COLOR Ink2, Paper2: PRINT WriteDate$(W&)
  1090.       LOCATE 10,6
  1091.       COLOR Ink1, Paper1: PRINT "  (This Date was a ";
  1092.       COLOR Ink2, Paper2: PRINT WkDay$(W&);
  1093.       COLOR Ink1, Paper1: PRINT " )."
  1094.  
  1095.       Today$ = GetDate$ '                                      a function ...
  1096.       LOCATE 12,6: COLOR Ink1, Paper1: PRINT "Today is ";
  1097.       COLOR Ink2, Paper2
  1098.       PRINT Today$
  1099.       LOCATE 14,6: COLOR Ink1, Paper1: PRINT "YOUR AGE IS: ";
  1100.       COLOR Ink2, Paper2
  1101.       PRINT YearsSince (DoB$)
  1102.       BDay$ = DoB$: MID$ (Bday$,7) = RIGHT$ (Today$,2)
  1103.  
  1104.       N = FigDate& (BDay$) - FigDate& (Today$)
  1105.       LOCATE 16,6: COLOR Ink1, Paper1
  1106.       SELECT CASE N
  1107.          CASE 0
  1108.            L = CSRLIN: C = POS
  1109.            COLOR Ink1+16, Paper1
  1110.            PRINT "HAPPY BIRTHDAY !!"
  1111.            LOCATE ,,0
  1112.            PLAY "O2 G8 G16 A4 G4 O3 C4 O2 B2": DELAY 2
  1113.            COLOR Ink1, Paper1: LOCATE L,C,1
  1114.            PRINT "HAPPY BIRTHDAY !!"
  1115.          CASE > 0
  1116.            PRINT "Your BIRTHDAY is only ";N;" days from today !"
  1117.            If SoundOn THEN PLAY TaskBeep$
  1118.          CASE < 0
  1119.            PRINT "Your BIRTHDAY was ";ABS(N);" days ago."
  1120.            If SoundOn THEN PLAY TaskBeep$
  1121.       END SELECT
  1122.  
  1123.  LOCATE 25,1: CALL ClearLine
  1124.  CALL PressAKey
  1125.  GOSUB Done
  1126.  
  1127. Done:
  1128.  RETURN MainMenu
  1129.  
  1130. '__________________________________________________________________________
  1131.  
  1132. Logo2:
  1133.   DATA HB's ALL-PURPOSE LIBRARY DEMO, For POWER BASIC, JULY 1990, END
  1134.   RESTORE Logo2
  1135.   CALL BOXMESSAGE (0,0,1)
  1136.     RETURN
  1137.  
  1138. Logo3:
  1139.   RESTORE Logo2
  1140.   CALL BOXMESSAGE (1,1,1)
  1141.     RETURN
  1142.  
  1143. '__________________________________________________________________________
  1144.  
  1145.  
  1146. SUB CloseFiles PUBLIC
  1147.  
  1148. '      What normally has to be done here, in a database program, is the
  1149. '      index file closures (writing back data). If the program just crashes
  1150. '      out to DOS, thus automatically closing all files at the DOS level,
  1151. '      the index files will have been corrupted.
  1152.  
  1153.    Dummy = IsRodent '                    also reset your furry friend if any ...
  1154.  
  1155.  END SUB
  1156.  
  1157.  
  1158. ' ______________________________________________________________________
  1159.  
  1160. Oops:
  1161. '         if error is the printer, beeps til you press a key; if any other
  1162. '         error, calls file closure procedures and ends the program ...
  1163.  SELECT CASE ERR
  1164.    CASE 52, 53, 54, 55, 58, 61, 64, 67, 70, 71, 72, 73, 74, 75, 76
  1165.      PLAY "ML O0 C16 D64"
  1166.      FileError = %True
  1167.      L00 = CSRLIN: C00 = POS
  1168.      CALL SCREENPUSH
  1169.      IF ErrorMessage$ <> "" THEN
  1170.        LOCATE 23,1: COLOR %Red, %Wht: CALL ClearLine
  1171.        PRINT "      => ";ErrorMessage$
  1172.      END IF
  1173.      BoxColor = %Wht + %Background * %Red
  1174.      CALL QBox (6, 20, 1,"OOPS: DOS UNABLE TO USE FILE. ERROR" + STR$(ERR), 0)
  1175.      DELAY 1
  1176.      CALL PressAKey
  1177.      CALL SCREENPOP
  1178.      LOCATE L00, C00
  1179.      RESUME NEXT
  1180.  
  1181.    CASE 24, 25, 27
  1182.      DATA "P R I N T E R   E R R O R"
  1183.      DATA "====="
  1184.      DATA "Please check the printer. Apparently it is either"
  1185.      DATA "off, not on-line, unplugged or out of paper."
  1186.      DATA "Kindly FIX IT ... then PRESS ANY KEY to"
  1187.      DATA "go ahead with printing"
  1188.      DATA END
  1189.  
  1190.      L00 = CSRLIN: C00 = POS
  1191.      CALL SCREENPUSH
  1192.      IF ErrorMessage$ <> "" THEN
  1193.        LOCATE 23,1: COLOR %Red, %Wht: CALL ClearLine
  1194.        PRINT "      => ";ErrorMessage$
  1195.      END IF
  1196.      RESTORE Oops
  1197.      CALL BOXMESSAGE (6, 16, 1)
  1198.      DO
  1199.         PLAY "O3 C64 P16 O4 C64 O3 P16 G-64"
  1200.         FOR N = 1 TO 30
  1201.           DELAY .1
  1202.           IF INSTAT THEN EXIT FOR
  1203.         NEXT
  1204.      LOOP UNTIL INSTAT
  1205.      CALL SCREENPOP
  1206.      LOCATE L00, C00
  1207.      IF INKEY$ = CHR$(27) THEN
  1208.        CALL CloseFiles
  1209.        END 1
  1210.      ELSEIF  ErrorMessage$ = "fake error generated from HBDEMO menus" THEN
  1211.        JustDemonstratingOops = %False
  1212.        RESUME NEXT
  1213.      ELSE
  1214.        RESUME
  1215.      END IF
  1216.    CASE ELSE
  1217.      PLAY "ML O0 C16 D64"
  1218.      IF ErrorMessage$ <> "" THEN
  1219.        LOCATE 21,1: COLOR %Red, %Wht: CALL ClearLine
  1220.        PRINT "      => ";ErrorMessage$
  1221.      END IF
  1222.      LOCATE 22,1: COLOR %Red, %Wht: CALL ClearLine
  1223.      PRINT " OOPS! UNABLE TO CONTINUE. ERROR";ERR;" AT ADDRESS ";ERADR;"     "
  1224.      COLOR %Red, %Gry
  1225.      BXScreenSaved = %False
  1226.      CALL CloseFiles
  1227.      COLOR %Grn, %Blk
  1228.      LOCATE 25,1: CALL ClearLine
  1229.      LOCATE 24,1: CALL ClearLine: END 1 '                 this places the DOS
  1230.  END SELECT '                                            prompt at 25,1 for you
  1231.  RESUME '                                                without messing up
  1232. '                                                        the display otherwise.
  1233. '                           Note: ERRORLEVEL is set to 1.
  1234. HarmlessError:
  1235.  
  1236.    DATA "FILE ERROR APPARENTLY"
  1237.    DATA "====="
  1238.    DATA "PRESS ANY KEY"
  1239.    DATA END
  1240.    ON ERROR GOTO 0
  1241.    L00 = CSRLIN: C00 = POS
  1242.    Ink3 = %Wht + %Flash
  1243.    Paper3 = %Red
  1244.    BXScreenSaved = %False
  1245.    RESTORE HarmlessError
  1246.    CALL SCREENPUSH
  1247.    CALL BOXMESSAGE (6, 16, 1)
  1248.    PLAY "O3 B32 P64 G32"
  1249.    DO: LOOP UNTIL INKEY$ <> ""
  1250.    CALL SCREENPOP
  1251.    LOCATE L00, C00
  1252.    RESUME NEXT
  1253.  
  1254. SetBeeps:
  1255.   LookitBeep$ = "T100 O5 C64 P64 O4 E64"
  1256.   ArribaBeep$ = "T70 O2 A32 P32 A32 A32 > E4"
  1257.   TaskBeep$ = "MN T100 O3 C16 E32 F32 G16 E16 C16"
  1258.   PressAKeyBeep$ = "T120 MS O4 P4 G64 P16 G64 MN"
  1259.   OopsBeep$ = "T120 O1 A64"
  1260.   TinyBeep$ = "MS T240 O3 C64"
  1261.  RETURN
  1262.  
  1263. FakeFunction:
  1264.  COLOR %LCyn, %Blu
  1265.  If SoundOn THEN PLAY LookitBeep$
  1266.  CLS
  1267.  LOCATE 10,10,0:PRINT "This function will of course be brilliantly implemented"
  1268.  DELAY .5
  1269.  LOCATE 12, 11: PRINT "by you, the creator of your own magnificent applications
  1270.  DELAY .5
  1271.  LOCATE 14, 13: PRINT "using Power Basic and this humble Library."
  1272.  If SoundOn THEN PLAY ArribaBeep$
  1273.  CALL PressAKey
  1274.  GOTO MainMenu
  1275.  
  1276. '____________________________________________________________________________
  1277.  
  1278. MZap:
  1279.  NextScrn2Pop = MainMenuScreen
  1280.  CALL SCREENPOP
  1281.  DEF SEG = VideoSeg&
  1282.  TopAtt = PEEK (1)
  1283.  FOR I = 161 TO 320 STEP 2: POKE I, TopAtt: NEXT
  1284.  DEF SEG
  1285.  RETURN
  1286.  
  1287. ClickOrStrike:
  1288.  DO: LOOP UNTIL INKEY$ <> "" OR MouseClicked
  1289.  RETURN
  1290.  
  1291.  
  1292. ' ===========================================================================
  1293.  
  1294. Directory:
  1295.  
  1296.  DIM DYNAMIC ListOfDirectories$ (32)
  1297.  CALL QBox (5,36,1,"FileSpec ?? ", 20)
  1298.  COLOR FldColor MOD 16, FldColor \ 16
  1299.  M$ = "*.*"
  1300.  CALL ENTERSTRING (M$, 20, "Cap")
  1301.  U$ = "File \            \ saved \      \ at \       \  --  "
  1302.  M$ = FQFileSpec$ (M$)
  1303.  Heading$ = "HB Custom Directory of " + M$
  1304.  Heading$ = LEFT$ (Heading$, 80)
  1305.  
  1306.  COLOR %Cyn, %Blk: CLS: LOCATE 1, 41-LEN(Heading$)\2: PRINT Heading$
  1307.  
  1308.  Fls% = 0
  1309.  FlName$ = M$
  1310.  CALL DirFirst (FlName$, FileSize&, DateCode&, TimeCode&)
  1311.  IF FlName$= "" THEN
  1312.    CALL QBox (11, 30, 1, "No file "+ M$ +" found", 0)
  1313.    CALL PressAKey
  1314.    RETURN
  1315.  ELSE
  1316.    INCR Fls%
  1317.    GOSUB PrDir
  1318.    DO
  1319.      CALL DirNext (FlName$, FileSize&, DateCode&, TimeCode&)
  1320.      IF FlName$ = "" THEN EXIT LOOP
  1321.      GOSUB PrDir
  1322.      INCR Fls%
  1323.      IF CSRLIN > 23 THEN
  1324.        COLOR %Cyn, %Blk
  1325.        IF NeedDCon THEN
  1326.          PRINT "                   ... PRESS ANY KEY (OR MOUSEBUTTON) TO GO ON";
  1327.        ELSE
  1328.          PRINT "                                   ... PRESS ANY KEY TO GO ON";
  1329.        END IF
  1330.        T& = TIMER
  1331.        DO: K$ = INKEY$: LOOP UNTIL K$ <> "" OR MouseClicked OR TIMER - T& > 4
  1332.        IF K$ = CHR$ (27) THEN GOTO DoneDirectory
  1333.        COLOR %Cyn, %Blk: CLS
  1334.        LOCATE 1, 41-LEN(Heading$)\2: PRINT Heading$
  1335.      END IF
  1336.    LOOP
  1337.    PRINT
  1338.    COLOR %Cyn, %Blk: PRINT Fls% ;"Files found"
  1339.  END IF
  1340.  
  1341.  IF RIGHT$ (M$, 3) = "*.*" THEN  '         only show subdirectories if a full
  1342.    PRINT '                                 directory was listed
  1343.    COLOR %Wht, %Blk
  1344.    PRINT STRING$ (80, 205);
  1345.    PRINT
  1346.    PRINT "Subdirectories of "; M$;
  1347.    N = 1: D% = 1
  1348.    DO WHILE (ListOfDirectories$ (N)) <> ""
  1349.      PRINT
  1350.      IF MID$ (ListOfDirectories$ (N), 2, 1) <> "." THEN
  1351.        PRINT USING " \           \  (directory)"; ListOfDirectories$ (N);
  1352.        INCR D%
  1353.      END IF
  1354.      INCR N
  1355.    LOOP UNTIL INKEY$ <> ""
  1356.    IF D% = 1 THEN PRINT "  None"
  1357.  END IF
  1358.  
  1359.  CALL PressAKey
  1360.  
  1361. DoneDirectory:
  1362.  ERASE ListOfDirectories$
  1363.  D% = 0
  1364.  RETURN
  1365.  
  1366. PrDir:
  1367.  IF ColorDisplay THEN
  1368.    COLOR 2 + (7 * (CSRLIN - 2*(CSRLIN\2))), 0
  1369.  ELSE
  1370.    COLOR (7 * (CSRLIN - 2*(CSRLIN\2))), 7 - (7 * (CSRLIN - 2*(CSRLIN\2)))
  1371.  END IF
  1372.  IF LEFT$ (FlName$, 1) = "<" THEN
  1373.    INCR D%
  1374.    ListOfDirectories$ (D%) =FlName$
  1375.  ELSE
  1376.    PRINT USING U$; FlName$, DecodeDate$ (DateCode&), DecodeTime$ (TimeCode&);
  1377.    IF FileSize& < 1024 THEN
  1378.      PRINT USING "   #### bytes"; FileSize&
  1379.    ELSE
  1380.      PRINT USING "###.# KB"; FileSize& / 1024
  1381.    END IF
  1382.  END IF
  1383.  RETURN
  1384.  
  1385. ' ======================================================================
  1386.                                  $SEGMENT
  1387. ' ======================================================================
  1388.  
  1389.  
  1390. MoveAMenuII:
  1391.    S = NextScrn2Pop
  1392.    NextScrn2Pop = 1
  1393.    CALL SCREENPOP
  1394.    NextScrn2Pop = S
  1395.    DELAY 1
  1396.  
  1397.    RANDOMIZE TIMER
  1398.    FOR Word = 1 TO 50
  1399.      LOCATE INT (1+RND*25), INT (1+RND*61)
  1400.      COLOR INT (1+RND*15), 0: PRINT "Important Data";
  1401.      DELAY .05
  1402.    NEXT Word
  1403.  
  1404.    MenuColor =  %Blk + %Background * %Gry
  1405.    BarColor =  %Ylo + %Background * %Grn
  1406.  
  1407.  FakePage = 1
  1408.  FakePages = 2
  1409.  D = 3: R = -4
  1410.                   ' menu lines are set up (D,R,L & Q will be the HotKeys) ...
  1411.  MenuData$(1) = "U UP"
  1412.  MenuData$(2) = "D DOWN"
  1413.  MenuData$(3) = "R RIGHT"
  1414.  MenuData$(4) = "L LEFT"
  1415.  MenuData$(5) = "Q QUIT"
  1416.  MenuData$(6) = "END"
  1417.  
  1418.  Choice = 1
  1419.  
  1420.  
  1421.  DO
  1422.    Title$ = "MOVE ME"                                    ' title
  1423.    MenuRight = R
  1424.    MenuDown = D
  1425.    CALL SCREENPUSH
  1426.  
  1427.    IF FakePage < FakePages THEN UsePgDn = %Yes ELSE UsePgUp = %Yes
  1428.  
  1429.    CALL SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
  1430.  
  1431.    CALL SCREENPOP
  1432.    If SoundOn THEN PLAY TinyBeep$
  1433.  
  1434.    SELECT CASE Choice
  1435.      CASE 1
  1436.       IF D > 0 THEN DECR D,2
  1437.      CASE 2
  1438.       IF D < 30 THEN IF D = 3 THEN INCR D,1 ELSE INCR D,2
  1439.      CASE 3
  1440.       IF R < 40 THEN INCR R,4
  1441.      CASE 4
  1442.       IF R > -40 THEN DECR R,4
  1443.    END SELECT
  1444.  IF Ky% = %PgDn THEN INCR FakePage: D = 20
  1445.  IF Ky% = %PgUp THEN DECR FakePage: D = 1
  1446.  
  1447.  IF ColorDisplay THEN
  1448.    COLOR 15,5
  1449.  ELSE
  1450.    COLOR 0,7
  1451.  END IF
  1452.  
  1453.  LOCATE 25,3,0
  1454.  PRINT "ARGUMENTS: Choice = ";Choice;"MenuDown = ";D;
  1455.  PRINT "   --   ";"MenuRight = ";R;
  1456.  
  1457.  IF Ky% = %F1 THEN GOSUB MenuHelpScrn
  1458.  
  1459.  IF Ky% = %F2 THEN LOCATE 23,1: COLOR 14,7: PRINT " F2 Pressed! "
  1460.  
  1461.  LOOP UNTIL Choice = 5 OR Ky% = %Esc
  1462.  GOSUB SetColors
  1463.  RETURN
  1464.  
  1465.  
  1466. HundredItemsMenu:
  1467.  CALL SCREENPUSH '                              a multipage menu ...
  1468.  RANDOMIZE TIMER
  1469.  StartScreen =  NextScrn2Pop
  1470.  REDIM T$ (1:100)
  1471.  MenuPages = 7
  1472.  DO
  1473.    COLOR 0, RND * 8: CLS
  1474.    COLOR %Ylo, %Grn
  1475.    MenuPage = 1
  1476.    Choice = 1
  1477.    DATA "Hundred Items", "Menu", "====", Use PG-DN or just
  1478.    DATA drag bar down past, last line to see, "more choices"
  1479.    DATA END
  1480.    RESTORE HundredItemsMenu
  1481.    CALL BOXMESSAGE (2, 1, 1)
  1482.    FOR I = 1 TO 100
  1483.      T$ (I) = USING$ ("  This is menu item  ###", I)
  1484.    NEXT
  1485.  
  1486.    DO
  1487.      FOR I = 1 TO 16
  1488.        IF (MenuPage - 1) * 16 + I > 100 THEN
  1489.          MenuData$ (I) = "END"
  1490.        ELSE
  1491.          MenuData$ (I) = T$ ((MenuPage - 1) * 16 + I)
  1492.        END IF
  1493.      NEXT
  1494.  
  1495.      MenuData$ (17) = "END"
  1496.      MenuRight = 6 * MenuPage -20
  1497.      MenuDown = MenuPage - 1
  1498.      Title$ = "PgUp/Pg-Dn for more"
  1499.      IF MenuPage > 1 THEN UsePgUp = %Yes
  1500.      IF MenuPage < 7 THEN UsePgDn = %Yes
  1501.  
  1502.      CALL SUPERMENU (MenuData$ (), MenuRight, MenuDown, Choice, Title$, Ky%)
  1503.  
  1504.      SELECT CASE Ky%
  1505.        CASE %PgUp
  1506.          DECR MenuPage
  1507.          CALL SCREENPOP
  1508.          Choice = 16
  1509.        CASE %PgDn
  1510.          INCR MenuPage
  1511.          CALL SCREENPUSH
  1512.          Choice = 1
  1513.        CASE %F1
  1514.          GOSUB MenuHelpScrn
  1515.      END SELECT
  1516.    LOOP UNTIL Ky% = %Esc OR Ky% = %CR
  1517.    NextScrn2Pop = StartScreen
  1518.    CALL SCREENPOP
  1519.  LOOP UNTIL Ky% = %Esc
  1520.  ERASE T$
  1521.  RETURN MainMenu
  1522.  
  1523. '   -------------------------------------------------------------------
  1524.  
  1525. SetColors:
  1526.  
  1527.  
  1528.  IF COMMAND$ <> "" THEN
  1529.    ScrColor = ReadParamFor ("ScrC") '              ReadParamFor looks
  1530.    MenuColor = ReadParamFor ("MnuC") '            for a command line switch
  1531.    BarColor = ReadParamFor ("BarC") '            like "BoxC=3F", for example,
  1532.    WinColor = ReadParamFor ("WinC") '            which sets the color of a
  1533.    FldColor = ReadParamFor ("FldC") '            box to &H3F (like COLOR 15,3)
  1534.    BoxColor = ReadParamFor ("BoxC")  '           that is, white letters on cyan
  1535.  ELSE '                                          background ...
  1536.    MenuColor = 0:  BarColor = 0:   WinColor = 0
  1537.    FldColor = 0:   BoxColor = 0:   ScrColor = 0
  1538.  END IF
  1539.  
  1540. '                                 then if colors are not yet set (= 0) we give
  1541. '                                   them a default value here:
  1542.  IF ColorDisplay THEN
  1543.    IF MenuColor = 0 THEN MenuColor =  %Wht + %Background * %Blu
  1544.    IF BarColor = 0 THEN BarColor =  %Ylo + %Background * %Red
  1545.    IF WinColor = 0 THEN WinColor =  %Blu + %Background * %Gry
  1546.    IF FldColor = 0 THEN FldColor =  %Ylo + %Background * %Red
  1547.    IF BoxColor = 0 THEN BoxColor =  %Wht + %Background * %Grn
  1548.    IF ScrColor = 0 THEN ScrColor =  %Wht + %Background * %Vlt
  1549.  ELSE
  1550.    IF MenuColor = 0 THEN MenuColor =  %Blk + %Background * %Gry
  1551.    IF BarColor = 0 THEN BarColor =  %Gry + %Background * %Blk
  1552.    IF WinColor = 0 THEN WinColor =  %Gry + %Background * %Blk
  1553.    IF FldColor = 0 THEN FldColor =  %Blk + %Background * %Gry
  1554.    IF BoxColor = 0 THEN BoxColor =  %Wht + %Background * %Blk
  1555.    IF ScrColor = 0 THEN ScrColor =  %Gry + %Background * %Blk
  1556.  END IF
  1557.  
  1558.  RETURN
  1559.  
  1560. MenuHelpScrn:
  1561.  CALL SCREENPUSH
  1562.  RESTORE MenuHelpScrn
  1563.  
  1564.  DATA "WHAT DOES THIS MENU DO ??  --  Not much really. After all, this whole"
  1565.  DATA "program is nothing but a demo."
  1566.  DATA ""
  1567.  DATA "IN THAT CASE, HOW DO I USE A MENU LIKE THIS ??"
  1568.  
  1569.  DATA " I thought you'd never ask! Well, you can use ..."
  1570.  DATA "(1) THE ONE KEY METHOD: Just find which item on the menu you want."
  1571.  DATA "There will be a letter or number at the start of the"
  1572.  DATA "item. Just press it and that's all."
  1573.  DATA "(2) THE CURSOR KEY METHOD: Use the up or down cursor / arrow keys"
  1574.  DATA "to move the highlighted bar to your selection, then"
  1575.  DATA "press the ENTER key."
  1576.  DATA "(3) THE PLASTIC PEST METHOD: Your mouse can make the choice you want!"
  1577.  DATA "You don't see a mouse cursor but don't panic. Just press the left"
  1578.  DATA "button and drag the highlighted bar to your choice; then let go."
  1579.  DATA ""
  1580.  DATA "TO CANCEL THE MENU (Not make a choice):"
  1581.  DATA "Press the Escape key, or the right mouse button. (You can even press"
  1582.  DATA "the right button while you hold the left one -- or right after you"
  1583.  DATA "let it go.)"
  1584.  DATA END
  1585.  
  1586.        CALL BOXMESSAGE (%Center, %Center, 0)
  1587.  
  1588.  GOSUB ClickOrStrike
  1589.  CALL SCREENPOP
  1590.  RETURN
  1591.  
  1592. ' -------------------------------------------------------------------------
  1593.  
  1594. BeepTest:
  1595.  LOCATE 22,1
  1596.  IF ColorDisplay THEN
  1597.    Ink1 = %Blu:  Paper1 = %Cyn: Ink2 = %LCyn: Paper2 = %Blu
  1598.  ELSE
  1599.    Ink1 = %Gry:  Paper1 = %Blk: Ink2 = %Blk:  Paper2 = %Gry
  1600.  END IF
  1601.  DELAY .7: If SoundOn THEN PLAY LookitBeep$
  1602.  DO
  1603.    IF CSRLIN > 20 THEN
  1604.      COLOR Ink1, Paper1: CLS
  1605.      COLOR Ink2, Paper2
  1606.      LOCATE 1,22: PRINT " HB BEEP-TESTING ENVIRONMENT, V. 1.0 "
  1607.      LOCATE 22,1: CALL ClearLine
  1608.      LOCATE 23,1: CALL ClearLine
  1609.      PRINT "    Use syntax for PLAY as in BASICA and ";
  1610.      PRINT "PowerBasic, e.g. O0 G2 A4 B-4 P4 G4"
  1611.      LOCATE 24,1: CALL ClearLine
  1612.      COLOR Ink1, Paper1
  1613.      LOCATE 3,1
  1614.    END IF
  1615.  
  1616.    PLAY "O3"
  1617.    PRINT " PLAY ";CHR$(34);SPACE$(45);CHR$(34);
  1618.    LOCATE CSRLIN, 8
  1619.    Opt$ = "Auto Caps"
  1620.    CALL ENTERSTRING (A$, 45, Opt$)
  1621.    IF Opt$ = "ESC" OR A$ = "" THEN
  1622.       PRINT "                                   QUIT ?? ";
  1623.       Quit = GetYesOrNo
  1624.       IF Quit THEN
  1625.         EXIT LOOP
  1626.       ELSE
  1627.         GOTO There
  1628.       END IF
  1629.    ELSE
  1630.      ON ERROR GOTO Clunker
  1631.      IF A$ <> "" THEN PLAY A$
  1632.      ON ERROR GOTO Oops
  1633.      LOCATE (CSRLIN), 56
  1634.      PRINT "Print It ?";
  1635.      Yes = GetYesOrNo
  1636.      IF Yes THEN
  1637.         INPUT "                         Comment ? ",B$
  1638.         L = CSRLIN
  1639.         COLOR 16+Ink2, Paper2
  1640.         LOCATE 25,3,0: CALL ClearLine: PRINT "PRINTING ...";
  1641.         LPRINT "From HB PowerBasic Beep Tester, ";GetDate$;":"
  1642.         LPRINT "    Name: ";B$;" -- PLAY ";CHR$(34);A$;CHR$(34)
  1643.         LOCATE 25,1,1: CALL ClearLine
  1644.         COLOR Ink1, Paper1
  1645.         LOCATE L+1, 1
  1646.      ELSE
  1647.         PRINT
  1648.      END IF
  1649.    END IF
  1650. There:
  1651.  LOOP
  1652.  RETURN
  1653.  
  1654. Clunker:
  1655.  PLAY "O1 C2"
  1656.  A$ = ""
  1657.  RESUME NEXT
  1658.  
  1659. MessageBoxTest:
  1660.  COLOR ScrColor MOD 16, ScrColor \ 16
  1661.  CLS
  1662.  CALL QBox (3, %Center, 1, "DEMO OF MESSAGE WINDOWS (TRY TO MAKE IT FAIL!)", 0)
  1663.  
  1664.  COLOR ScrColor MOD 16, ScrColor \ 16
  1665.  LOCATE 10, 50: PRINT "... 0 = Horiz. Centered Box"
  1666.  LOCATE 10,5: PRINT "LEFT UPPER CORNER AT COLUMN ";
  1667.  COLOR FldColor MOD 16, FldColor \ 16
  1668.  CALL ENTERNUMBER (CCol#, "###", Opt$)
  1669.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1670.  
  1671.  COLOR ScrColor MOD 16, ScrColor \ 16
  1672.  LOCATE 12, 50: PRINT "... 0 = Vert. Centered Box"
  1673.  LOCATE 12,5: PRINT "LEFT UPPER CORNER AT ROW ";
  1674.  COLOR FldColor MOD 16, FldColor \ 16
  1675.  CALL ENTERNUMBER (CLin#, "###", Opt$)
  1676.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1677.  
  1678.  COLOR ScrColor MOD 16, ScrColor \ 16
  1679.  LOCATE 14,5: PRINT " MARGIN ? ";
  1680.  COLOR FldColor MOD 16, FldColor \ 16
  1681.  CALL ENTERNUMBER (Marg#, "#", Opt$)
  1682.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1683.  Margin = MIN (CINT(Marg#), 3)
  1684.  
  1685.  COLOR ScrColor MOD 16, ScrColor \ 16
  1686.  LOCATE 16,5: PRINT "HOW LONG SHALL WE MAKE THE TEXT LINES ? ";
  1687.  COLOR FldColor MOD 16, FldColor \ 16
  1688.  CALL ENTERNUMBER (LinL#, "###", Opt$)
  1689.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1690.  
  1691.  COLOR ScrColor MOD 16, ScrColor \ 16
  1692.  LOCATE 18,5: PRINT " ... AND HOW MANY LINES ? ";
  1693.  COLOR FldColor MOD 16, FldColor \ 16
  1694.  CALL ENTERNUMBER (LinsNum#, "###", Opt$)
  1695.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1696.  
  1697.  TenChr$ = "<Ten Chrs>"
  1698.  Digital$ = "123456789"
  1699.  N = INT (LinsNum#)
  1700.  L = INT (LinL#)
  1701.  Text4Box$ = REPEAT$ (L \ 10, TenChr$) + LEFT$ (Digital$, L MOD 10)
  1702.  DIM DYNAMIC T$ (1:N)
  1703.  FOR I = 1 TO N
  1704.    T$(I) = Text4Box$
  1705.  NEXT
  1706.  
  1707.     CALL BOXMESSAGE2 (CINT (CLin#), CINT (CCol#), Margin, T$(), N, L)
  1708.  
  1709.  CALL PressAKey
  1710.  CLS
  1711.  ERASE T$
  1712.  RETURN
  1713.  
  1714. QBoxTest:
  1715.  COLOR ScrColor MOD 16, ScrColor \ 16
  1716.  CLS
  1717.  CALL QBox (3, %Center, 1, "DEMO OF DIALOG BOX (TRY TO MAKE IT FAIL!)", 0)
  1718.  
  1719.  COLOR ScrColor MOD 16, ScrColor \ 16
  1720.  LOCATE 10, 50: PRINT "... 0 = Horiz. Centered Box"
  1721.  LOCATE 10,5: PRINT "LEFT UPPER CORNER AT COLUMN ";
  1722.  COLOR FldColor MOD 16, FldColor \ 16
  1723.  CALL ENTERNUMBER (CCol#, "###", Opt$)
  1724.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1725.  
  1726.  COLOR ScrColor MOD 16, ScrColor \ 16
  1727.  LOCATE 12, 50: PRINT "... 0 = Vert. Centered Box"
  1728.  LOCATE 12,5: PRINT "LEFT UPPER CORNER AT ROW ";
  1729.  COLOR FldColor MOD 16, FldColor \ 16
  1730.  CALL ENTERNUMBER (CLin#, "###", Opt$)
  1731.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1732.  
  1733.  Lins# = INT (Lins#)
  1734.  COLOR ScrColor MOD 16, ScrColor \ 16
  1735.  LOCATE 14,5: PRINT " ONE LINE BOX OR THREE LINE BOX ?? ";
  1736.  COLOR FldColor MOD 16, FldColor \ 16
  1737.  L = CSRLIN: C = POS
  1738.  DO
  1739.    LOCATE L, C
  1740.    Lins$ = " "
  1741.    CALL ENTERSTRING (Lins$, 1, Opt$)
  1742.    Lins = VAL (Lins$)
  1743.  LOOP UNTIL Lins = 1 OR Lins = 3
  1744.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1745.  
  1746.  COLOR ScrColor MOD 16, ScrColor \ 16
  1747.  LOCATE 16,5: PRINT "ENTER TEXT LINE: ";
  1748.  COLOR FldColor MOD 16, FldColor \ 16
  1749.  IF Prompt$ = "" then Prompt$ = "Sample Prompt"
  1750.  CALL ENTERSTRING (Prompt$, 40, Opt$)
  1751.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1752.  
  1753.  COLOR ScrColor MOD 16, ScrColor \ 16
  1754.  LOCATE 18,5: PRINT "LENGTH OF ANSWER FIELD ?";
  1755.  COLOR FldColor MOD 16, FldColor \ 16
  1756.  CALL ENTERNUMBER (AFL#, "##", Opt$)
  1757.  IF Opt$ <> "CR" THEN RETURN MainMenu
  1758.  
  1759.  
  1760.  AnsLength = CINT (AFL#)
  1761.  
  1762.     CALL QBox (CINT (CLin#), CINT (CCol#), Lins, Prompt$, AnsLength)
  1763.  
  1764.  DELAY 2
  1765.  COLOR FldColor MOD 16, FldColor \ 16
  1766.  FOR I = 1 TO AnsLength
  1767.    PRINT " ";
  1768.    DELAY .03
  1769.  NEXT
  1770.  DELAY 1
  1771.  CALL PressAKey
  1772.  COLOR ScrColor MOD 16, ScrColor \ 16
  1773.  CLS
  1774.  RETURN
  1775.  
  1776.