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