Power-Programmierung/CD1.mdf/basic/library/pb/library4/fentry-u.bas

BASIC Source File | 1990-09-16 | 21.8 KB | 782 lines

'==============================================================================
'                    THE FIRST UNIT -- FENTRY.BAS
'==============================================================================
'                                                               -- 2-13-90
                            $COMPILE UNIT
                            $ERROR ALL OFF


 DEFINT A-Z

 %False = 0
 %True = NOT %False
 %ReadRodent = 3
 %LeftButton = 1
 %RightButton = 2
 %MaxDecPlaces = 4

 EXTERNAL RD$, ColorDisplay, NeedDCon
 EXTERNAL BoxColor, FldColor, WinColor, ScrColor
 EXTERNAL CursorTop, CursorBottom, Ln, Col
 EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
 EXTERNAL LocalAreaCode$, Record%

 DECLARE FUNCTION FigDate& (STRING)
 DECLARE FUNCTION WriteDate$ (LONG)

 DECLARE SUB CloseFiles ()
 DECLARE SUB Mouse (INTEGER, INTEGER, INTEGER, INTEGER)
 DECLARE SUB BOXMESSAGE2 (INTEGER, INTEGER, INTEGER, STRING ARRAY,_
                                                           INTEGER, INTEGER)
 DECLARE SUB SCREENPUSH ()
 DECLARE SUB SCREENPOP ()



SUB ENTERSTRING (Wkg$,FLength,Opt$) PUBLIC

'   WHAT IS THIS ?? This routine provides a field right at the present cursor
'         location for the operator to enter something into (if it starts off
'         blank) or edit. Wkg$ is the current value of the field.  FLength =
'         length of field.
'
'         Opt$ may be "" or may hold the strings "Cap" for all uppercase,
'         "Auto" to automatically go on when the field is full, "UpOut" or
'         "BackOut" if UpArrow or Left/ backspace keys are to be able to end
'         entry; also may include "Ins" to start up in the insert mode, and/or
'         "-" if the minus sign is allowed to be entered.
'
'         Active keys also include:  ^Y to clear the line
'                                    ^T to delete one word (to right)
'                                    ^U to undo (restore original string)
'                                     Home, End, cursor rt/left,
'                                    ^cursor (jumps to beginning of a word)
'
'         If there is something in the field to begin with and the operator
'         starts typing something else, the field clears. If the cursor is
'         moved around first, that doesn't happen.
'
'         On exiting sub, Opt$ will be reset as "Left", "Auto", "Up", "Down",
'         "HELP!", "F2", "ESC" or "CR", "Tab" or "ShfTab" according to what
'         event terminated the entry
'         process. At any time during string entry the operator can press [CR] or
'         DOWN-ARROW to enter; [F2] can be pressed  (I use F2 for Database
'         Function commands  -- Clear, Find, Next/Prev, Save etc.) or F1 can also
'         be made active (for a help key) ...


  LOCAL Fpos, Masq$,Starting$, Numeric, Auto, Caps, UpOut, BackOut, K$,_
       NoNeg, InsertStatus, Z, NumKStrokes, StartWord, EndWord, Done


 Wkg$ = LEFT$ (Wkg$, FLength)
 Starting$ = Wkg$ '                                    save starting string --
  Ln = CSRLIN: Col = POS
'                                         Scan the Option String for Codes ...
'                                                and set flags accordingly
 Numeric = INSTR(Opt$,"Num")
 Auto = INSTR(Opt$,"Auto")
 Caps = INSTR(Opt$,"Cap")
 UpOut = INSTR(Opt$,"UpOut")
 BackOut = INSTR(Opt$,"BackOut")
 IF INSTR (Opt$, "-") = 0 THEN NoNeg = %True
 IF INSTR (Opt$, "Ins") THEN InsertStatus = %True

 IF FLength > 1 THEN
    Masq$ = "\"+SPACE$(FLength-2)+"\"
 ELSEIF FLength = 1 THEN
    Masq$ = "!"
 ELSE
    PRINT "SETUP ERROR -- STRING FIELD HAS LENGTH < 1 !!"
    Done = %True
 END IF

 FPos = 1

'                   ============ WRITE THE FIELD TO DISPLAY =============
 DO UNTIL Done

   LOCATE Ln, Col,0 '                                   print the string
   PRINT USING Masq$;Wkg$
'                                    now, if you already pressed Up or ShfTab,
'                                    we'll exit after printing restored line
   IF Opt$ = "Up" OR Opt$ = "ShfTab" THEN EXIT LOOP
'                      if "auto-CR" is on and we have reached the end, quit ...
   IF Auto AND FPos > FLength THEN Opt$ = "Auto": EXIT LOOP
'                     if there are trailing spaces, get rid of them
'                     unless the cursor is out to the right of the last chr ...
   IF FPos =< LEN(Wkg$) THEN Wkg$ = RTRIM$(Wkg$)

 '                 ================== SET CURSOR: ===========================

   IF ColorDisplay THEN
     LOCATE Ln,(Col+FPos-1),1,(6+2*InsertStatus),7
   ELSE
     LOCATE Ln,(Col+FPos-1),1,(11+4*InsertStatus),12
   END IF

   DO:LOOP UNTIL INSTAT '                   ****************************
   K$ = INKEY$  '                          **   RECEIVE KEYPRESS ...   **
 '                                          ****************************


   INCR NumKStrokes


   SELECT CASE K$

      CASE CHR$(0)+CHR$(&H48)
         GOSUB EUpArrow
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(&H4B)
         GOSUB ELeftArrow
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(&H4D)
         GOSUB ERightArrow
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(&H50)
         GOSUB EDownArrow
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(&H47)
         GOSUB EHomeKey

      CASE CHR$(0)+CHR$(&H4F)
         GOSUB EEndKey

      CASE CHR$(0)+CHR$(&H53)
         GOSUB EDelKey

      CASE CHR$(0)+CHR$(&H52)
         GOSUB EInsKey

      CASE CHR$(0)+CHR$(&H3B)
         GOSUB EF1Key
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(&H3C)
         GOSUB EF2Key
         IF Done THEN EXIT LOOP

      CASE CHR$(0)+CHR$(115)
         GOSUB ECtrlLeftKey

      CASE CHR$(0)+CHR$(116)
         GOSUB ECtrlRightKey

      CASE CHR$(13)                'you pressed [CR]: exit w/ resulting string
        Opt$ = "CR"
        EXIT LOOP

      CASE CHR$(8) '                                    You pressed [BACKSPACE].
         DECR FPos '                                    back up 1 space;
         IF FPos < 1 THEN '                                if cursor is trying
           IF BackOut THEN '                           to get out the left side
             Opt$ = "Left" '                             of the box and BackOut
             EXIT LOOP '                                  is on, then exit;
           ELSE
             FPos = 1 '  : GOTO ESetCursor (I'M ELIMINATING THE SKIPWRITE LABEL ...)
           END IF
         ELSE
           GOSUB EDelKey '                                 else delete character.
         END IF

      CASE CHR$(27)                    ' you pressed [ESC]: exit
         Opt$ = "ESC"
         EXIT LOOP

      CASE CHR$(9)                    ' you pressed [TAB]: exit
         Opt$ = "Tab"
         EXIT LOOP

      CASE CHR$(0) + CHR$(15)                    ' you pressed [ShfTAB]: exit
         Opt$ = "ShfTab"
         EXIT LOOP

      CASE CHR$(20)
         StartWord = FPos
         DO UNTIL MID$ (Wkg$,StartWord,1) = " " OR StartWord = 1
           DECR StartWord
         LOOP
         EndWord = FPos
         DO
           INCR EndWord
         LOOP UNTIL MID$ (Wkg$,EndWord,1) = " " OR EndWord > LEN(Wkg$)
         Wkg$ = LEFT$ (Wkg$, StartWord-1) + MID$ (Wkg$, EndWord)
         IF LEFT$(Wkg$,1) = " " THEN Wkg$ = MID$(Wkg$,2)
         FPos = StartWord

      CASE CHR$(25)   '                                      you pressed ^Y
         Wkg$ = ""
         FPos = 1

      CASE CHR$(21)   '                                      you pressed ^U
         Wkg$ = Starting$
         FPos = 1

 CASE ELSE '                                       some other key was pressed.

 IF ((LEN(Wkg$) < FLength) OR NOT InsertStatus)_
                       OR NumKStrokes = 1  THEN '  if field isn't full yet, or
'                                                  INS is off, or just starting
   IF  NumKStrokes = 1 THEN Wkg$ = ""
                               '  this zaps the old entry if you
        SELECT CASE ASC(K$) '                        start a new one ...
           CASE 1 TO 31, >126
             K$ = "": EXIT SELECT '                  eliminate invalid chrs ...
           CASE 32 TO 44, 47, >57
             IF Numeric THEN PLAY "O3 A64":K$ = "": EXIT SELECT
           CASE 45
             IF Numeric AND NoNeg THEN PLAY "O3 A64":K$ = "": EXIT SELECT
       END SELECT
       IF Caps THEN K$ = UCASE$(K$)
       IF FPos > LEN(Wkg$) THEN

             DO WHILE FPos-LEN(Wkg$) > 1: Wkg$ = Wkg$ + " ": LOOP
'                                                add spaces out to cursor pos.
             Wkg$=Wkg$+K$ '                             ...  and tack on K$

     ELSE
             Wkg$ = LEFT$(Wkg$,FPos-1)+K$+MID$(Wkg$,FPos+1+InsertStatus)
     END IF
    '                               the long line plugs K$ in -- the hard way!
     IF K$ <> "" THEN INCR FPos

   ELSE  '                            else,  the line is full and Auto is off

        PLAY "O0 A64"  '              so we ignore the keystroke & just Beep

   END IF

 END SELECT

 LOOP

'                           ***************** END OF MAIN LOOP

 LOCATE ,,1,CursorTop,CursorBottom
 EXIT SUB

ELeftArrow:
  IF FPos > 1 THEN
'                                      Wkg$ = RTRIM$(Wkg$)
    FPos = FPos - 1
  ELSE
    IF BackOut THEN
       Opt$ = "Left"
       Done = %True
    END IF
  END IF
  RETURN

ERightArrow:
  IF FPos < FLength THEN
    INCR FPos
  ELSEIF Auto THEN
    Opt$ = "Auto"
    Done = %True '                                 if Auto is on then exit
  END IF
  RETURN

EInsKey:
  IF InsertStatus = %False THEN
    InsertStatus = %True
  ELSE
    InsertStatus = %False
  END IF
  RETURN

EDelKey:
  IF FPos = 1 THEN Wkg$ = MID$(Wkg$,2): RETURN
  IF FPos > LEN(Wkg$) THEN
    DECR FPos
  ELSE
    Wkg$ = LEFT$(Wkg$,FPos-1) + MID$(Wkg$,FPos+1)
  END IF
  RETURN

EHomeKey:
  FPos = 1
  RETURN

EEndKey:
  FPos = LEN(Wkg$)+1
  RETURN

ECtrlLeftKey:
 IF FPos > 1 THEN DECR FPos
 DO UNTIL FPos = 1
   DECR FPos
 LOOP UNTIL MID$ (Wkg$,FPos,1) = " "
 IF FPos > 1 THEN INCR FPos
 RETURN

ECtrlRightKey:
 DO
   INCR FPos
 LOOP UNTIL MID$ (Wkg$,FPos,1) = " " OR FPos > LEN (Wkg$)
 INCR FPos
 FPos = MIN (FPos, LEN(Wkg$)+1)
 RETURN

EUpArrow:
  IF UpOut THEN
    Wkg$ = Starting$
    Opt$ = "Up"
  END IF
  RETURN

EDownArrow:
  Opt$ = "Down"
  Done = %True
  RETURN


EF1Key:
 IF INSTR (Opt$, "F1") THEN
   Opt$ = "HELP!"
   Done = %True
 END IF
 RETURN


EF2Key:
 IF INSTR (Opt$, "F2") THEN
   Opt$ = "F2"
   Done = %True
 END IF
 RETURN

 END SUB                                              REM: ENTERSTRING

' -------------------------------------------------------------------
SUB ENTERNUMBER  (Wkg#, Masq$, Opt$) PUBLIC '          note: Shell for
'                                                                ENTERSTRING
'   =======                This the routine to enter a number onscreen. It
'                          makes the value into a string if <> 0 and calculates
'                          the field length based on Masq$.  Opt$ is simply
'                          passed without much alteration to ENTERSTRING.

 LOCAL Wkg$, FLength, DecPlaces

 IF VERIFY (Masq$, "#.-$!") THEN
   COLOR %Wht, %Blk
   BEEP: PRINT "ENTERNUMBER: MASK STRING ERROR": EXIT SUB
 END IF

 IF INSTR (Masq$, ".") THEN
   DecPlaces = TALLY (MID$ (Masq$, INSTR (Masq$, ".")), "#")
 ELSE
   DecPlaces = 0
 END IF
 Wkg# = ROUNDOFF# (Wkg#, DecPlaces)

 Ln = CSRLIN: Col = POS
 FLength = LEN (Masq$)
 Opt$ = "Num" + Opt$

 IF Wkg# = 0 THEN
    Wkg$ = ""
 ELSE
    Wkg$ = LTRIM$ (STR$(Wkg#))'     set working $.
 END IF

 IF INSTR (Wkg$,".") THEN            '                strip trailing zeroes ...
   Wkg$ = LEFT$(Wkg$,INSTR(Wkg$,".")+4)
   Wkg$ = RTRIM$ (Wkg$, "0")
   Wkg$ = RTRIM$ (Wkg$, ".")
 END IF

'                       -----------------------------------

                        CALL ENTERSTRING(Wkg$,FLength,Opt$)

'                       -----------------------------------

 Wkg# = VAL(Wkg$) '                                              reset Wkg# ...
 Wkg# = ROUNDOFF# (Wkg#, DecPlaces)
 LOCATE Ln, Col: PRINT USING Masq$;Wkg# '                            print it
'         ...

END SUB                                                         REM ENTERNUMBER

' -------------------------------------------------------------------

SUB ENTERDATE  (A$, Opt$) PUBLIC

 LOCAL L,C
'                                           set up to use the formatted entry
EnterDate1: '                                routine ENTERBUNCHES with 3 blank
 L = CSRLIN: C = POS '                      fields to fill and 2 hyphens
 DATA 2,"-",2,"-",2,"END"
 RESTORE EnterDate1
 Opt$ = Opt$ + "Num"

   CALL ENTERBUNCHES(A$, Opt$)
'                                          now check the result for being a
'                                          valid date (FnFigDate& returns > 0)

 IF (Opt$ = "CR" OR Opt$ = "Auto") AND FigDate& (A$) = 0 THEN
    A$ = "": LOCATE L,C: GOTO EnterDate1
 END IF

END SUB

' -------------------------------------------------------------------
SUB RotaDate  (D$,Opt$) PUBLIC
 LOCAL L, C, K$, I$()
 DIM I$ (3)
 L = CSRLIN: C = POS
 COLOR BoxColor MOD 16, BoxColor \ 16
 I$(1) = "To enter date shown press [CR]."
 I$(2) = " Use ["+CHR$(27)+"] or ["+CHR$(26)+"] to change."
 I$(3) = "For normal keyboard entry press SpaceBar."
 CALL SCREENPUSH
 CALL BOXMESSAGE2 (18, 24, 0, I$(), 3, 47)
 LOCATE L+1,C+2
 PRINT CHR$(17);CHR$(205);CHR$(205);CHR$(16)
 COLOR FldColor MOD 16, FldColor \ 16
 DO
   LOCATE L,C: PRINT D$;
   DO:LOOP UNTIL INSTAT
   K$ = INKEY$
   IF LEN(K$) < 2 THEN
     PLAY TinyBeep$
     IF K$ = CHR$(13) THEN
        Opt$ = "CR"
        CALL SCREENPOP
        EXIT SUB
     END IF
     IF K$ = CHR$(27) THEN
        Opt$ = "ESC"
        CALL SCREENPOP
        EXIT SUB
     END IF
     IF K$ = " " THEN
        Opt$ = "RegularEntry"
        CALL SCREENPOP
        EXIT SUB
     END IF
   ELSE
     K$ = RIGHT$(K$,1)

     SELECT CASE ASC(K$)
       CASE &H4B  '                                    left -- back date 1 day
         D$ = WriteDate$(FigDate&(D$) - 1)
       CASE &H4D  '                                right -- advance date 1 day
         D$ = WriteDate$(FigDate&(D$) + 1)
       CASE &H48 '                                                         up
         Opt$ = "Up": CALL SCREENPOP : EXIT SUB
       CASE &H50  '                                                        down
         Opt$ = "Down": CALL SCREENPOP : EXIT SUB
       CASE &H3C  '
         Opt$ = "F2": CALL SCREENPOP : EXIT SUB
       END SELECT

     PLAY TinyBeep$
   END IF
 LOOP

 END SUB
' -------------------------------------------------------------------


SUB ENTERTIME  (A$, Opt$) PUBLIC
 LOCAL L, C, Hours, H$, AmPm$

EnterTime1:
 DATA 2,":",2,"END"
 RESTORE EnterTime1
 Opt$ = Opt$ + "Num"
 L = CSRLIN: C = POS

   CALL ENTERBUNCHES(A$, Opt$)

 IF A$ <> "" THEN
    IF VAL (LEFT$(A$,2)) > 24 OR VAL (RIGHT$(A$,2)) > 59 THEN
      A$ = ""
      LOCATE L,C
      GOTO EnterTime1
    END IF

    IF RIGHT$ (A$,2) = "  " AND LEFT$ (A$,2) <> "  " THEN
      Hours = VAL(LEFT$ (A$,2))
      IF Hours > 10 THEN
         H$ = LEFT$(A$,2)
      ELSE
        H$ = LEFT$ (STR$(Hours),2)
      END IF
      A$ = H$ + ":00"
      LOCATE L,C: PRINT A$
    END IF

AMorPM:
    IF LEFT$(A$,2) <> "  " AND VAL (LEFT$(A$,2)) < 13 THEN
'                                             dialog box to select a.m. or p.m.
       CALL SCREENPUSH
'   Code to write Static Window {AM_PM} to Screen
'        note: created by StatWindow Writer (PWW) from AM_PM.PW

       COLOR BoxColor MOD 16, BoxColor \ 16
       LOCATE  9, 24
       PRINT "┌──────────────────────────────────────┐"
       LOCATE  10, 24
       PRINT "│    A - for A.M.                      │";
       LOCATE  11, 24
       PRINT "│    P - for P.M.                      │";
       LOCATE  12, 24
       PRINT "│        [ESC] to Quit                 │";
       LOCATE  13, 24
       PRINT "│              Time entered:           │";
       LOCATE  14, 24
       PRINT "└──────────────────────────────────────┘";

       COLOR FldColor MOD 16, FldColor \ 16
       LOCATE  13, 53
       PRINT USING  "\   \";A$;
       COLOR ScrColor MOD 16, ScrColor \ 16

'  08-22-1990, 18:40:   end of StatWindow generated code for window {AM_PM}
       DO
         AmPm$ = UCASE$ (INKEY$)
       LOOP UNTIL AmPm$ = "A" OR AmPm$ = "P"
       CALL SCREENPOP
       A$ = A$ + " " + MID$ ("a.m.p.m.", 5 + 4*(AmPm$="A"), 4)
       LOCATE L,C: PRINT A$
     END IF
 END IF
 END SUB

' -------------------------------------------------------------------

SUB ENTERSSN  (A$, Opt$) PUBLIC

EnterSSN1:
 DATA 3," ",2," ",4,"END"
 RESTORE EnterSSN1
 Opt$ = Opt$ + "Num"

   CALL ENTERBUNCHES(A$, Opt$)

END SUB

' -------------------------------------------------------------------


SUB ENTERPHONE  (A$, Opt$) PUBLIC

 LOCAL L,C

EnterPhone1:
 DATA "(",3,") ",3,"-",4," ext. ",5
 DATA END
EShortPhone:
 DATA "(",3,") ",3,"-",4
 DATA END
 LOCAL WithExtension

 IF INSTR(Opt$,"NoExt") THEN
     RESTORE EShortPhone
   ELSE
     RESTORE EnterPhone1
     WithExtension = %True
   END IF
 A$ = LTRIM$ (RTRIM$ (A$))
 IF A$ = "" THEN A$ = "("+LocalAreaCode$+")"
 Opt$ = Opt$ + "Num"

   CALL ENTERBUNCHES(A$, Opt$)

 A$ = LTRIM$ (RTRIM$ (A$))
 IF WithExtension THEN
   IF RIGHT$ (A$,4) = "ext." THEN A$ = LEFT$ (A$,19)  ' if no ext # then trim
   PRINT USING "\"+SPACE$(23)+"\"; A$  '                 off the word "ext."
 ELSE
   PRINT USING "\"+SPACE$(14)+"\"; A$
 END IF
 END SUB  '

' -------------------------------------------------------------------

SUB ENTERBUNCHES (A$, Opt$)
 LOCAL L, C, FLength, Sep$(), Size(), Bunch%, B$, B%, FPos, Opt0$
 DIM Sep$ (20): DIM Size (20)
 Bunch% = 1
 L = CSRLIN: C = POS
 READ B$
 DO UNTIL B$ = "END"
   IF INSTR("123456789",B$) THEN
      Size(Bunch%) = VAL (B$)
      INCR FLength, (LEN(Sep$(Bunch%))+Size(Bunch%))
      INCR Bunch%                   ' get sizes of bunches and separator chrs
   ELSE
      Sep$(Bunch%) = B$
   END IF
   READ B$
 LOOP

 A$ = A$ + SPACE$(FLength-LEN(A$))


 B% = 1
 FPos = 1                              '  this is to move the cursor past a
 IF Opt$ <> "Up" THEN
   DO UNTIL FPos > LEN(A$) '            full field:  check first chr of each
     IF MID$(A$,LEN(Sep$(B%))+FPos,1) <> " " THEN  '  bunch for being blank ...
       INCR FPos,  LEN(Sep$(B%)) + Size(B%)
       INCR B%                                  ' if it isn't, jump over it ...
     ELSE
       EXIT LOOP
     END IF
  LOOP
  IF Fpos >= FLength THEN B% = 1: FPos = 1  '            for a full field,
 END IF  '                                     set cursor back to pos. # 1 ...

'   now the bunch to start with is B% // the starting $ is A$


TakeEntry:
 LOCATE L,C: PRINT USING "\"+SPACE$(FLength-2)+"\"; A$

 Opt0$ = Opt$
 DO UNTIL Size(B%) = 0
   LOCATE L, (C + FPos-1)
   PRINT Sep$(B%);
   Ln = CSRLIN: Col = POS
   Opt$ = Opt0$+"Auto BackOut UpOut"
   B$ = MID$ (A$, FPos+LEN(Sep$(B%)), Size(B%))

     CALL ENTERSTRING (B$,Size(B%),Opt$)

   MID$(A$,FPos) = Sep$(B%)+B$

 SELECT CASE Opt$

   CASE "Left"
     IF B% > 1 THEN
       DECR B%
       DECR FPos, Size(B%)+LEN(Sep$(B%))
          END IF

   CASE "Up", "ESC", "F2", "HELP!", "Tab", "ShfTab", "CR", "Down"
     EXIT LOOP

   CASE "Auto"
     INCR FPos, Size(B%)+LEN(Sep$(B%))
     INCR B%

   CASE ELSE
     PRINT "ENTERBUNCHES: Error! Opt$ = "; Opt$; :CALL CloseFiles: STOP

 END SELECT
 LOOP

BunchDone:
 LOCATE L,C
END SUB  '                                          REM    ENTERBUNCHES

SUB PressAKey PUBLIC
 LOCAL Click

 LOCATE 20, 58, 0: COLOR 0,7
 PRINT "╔═════════════════╗"                ' pcWrite is great for boxing now!
 LOCATE 21, 58
 PRINT "║   HIT ANY KEY   ║"           ' (always did do a zippy search/replace)
 IF NeedDCon THEN
   LOCATE 22, 58
   PRINT "║ OR CLICK RODENT ║"
   LOCATE 23, 58
   PRINT "║    TO GO ON     ║"
   LOCATE 24, 58
   PRINT "╚═════════════════╝";
 ELSE
   LOCATE 22, 58
   PRINT "║    TO GO ON     ║"
   LOCATE 23, 58
   PRINT "╚═════════════════╝";
 END IF

 PLAY PressAKeyBeep$
 IF NeedDCon THEN
   DO
     CALL Mouse (%ReadRodent, Click, X, Y)
   LOOP UNTIL ((INKEY$ <> "") OR Click)
 ELSE
   DO: LOOP UNTIL INKEY$ <> ""
 END IF

 LOCATE ,,1

 END SUB
'____________________________________________________________________________

FUNCTION GetYesOrNo PUBLIC
   LOCAL X$
   PRINT " (y/n) ";
   DO WHILE X$ <> "Y" AND X$ <> "N"
     IF NeedDCon THEN
       DO
         CALL Mouse (%ReadRodent, Click, X, Y)
       LOOP UNTIL (INSTAT OR Click)
     ELSE
       Click = %False
       DO: LOOP UNTIL INSTAT
     END IF
     X$ = INKEY$
     X$ = UCASE$(X$)
     IF Click = %LeftButton THEN X$ = "Y"
     IF Click = %RightButton THEN X$ = "N"
   LOOP
   PRINT X$;
   GetYesOrNo = (X$ = "Y")
   END FUNCTION

SUB ENTERYESNO  (Yes) PUBLIC
 LOCAL Choice$, L, C
 COLOR FldColor MOD 16, FldColor \ 16
 L = CSRLIN
 C = POS
 PRINT "Y"
 LOCATE L, C
 DO
   DO:LOOP UNTIL INSTAT
   Choice$ = INKEY$
   SELECT CASE Choice$
     CASE "y", "Y", CHR$(13)
       PRINT "Y"
       Yes = %True
       EXIT LOOP
     CASE "n", "N", CHR$(27)
       PRINT "N"
       Yes = %False
       EXIT LOOP
     CASE ELSE
       PLAY OopsBeep$
   END SELECT
 LOOP
 END SUB '                                         REM -- ENTERYESNO

FUNCTION ROUNDOFF# (N#, Places%)
 SELECT CASE Places%
   CASE 0
     ROUNDOFF# = ROUND (N#, 0)
     EXIT SELECT
   CASE 1
     ROUNDOFF# = ROUND (N#, 1)
     EXIT SELECT
   CASE 2
     ROUNDOFF# = ROUND (N#, 2)
     EXIT SELECT
   CASE 3
     ROUNDOFF# = ROUND (N#, 3)
     EXIT SELECT
   CASE 4
     ROUNDOFF# = ROUND (N#, 4)
 END SELECT
END FUNCTION