'===========================================================================
' Subject: POPUP CALCULATOR                  Date: 12-05-98 (18:16)       
' Author:  Fred Buffington                   Code: QB, QBasic, PDS        
' Origin:  oasys@nstar.net                 Packet: ALGOR.ABC
'===========================================================================
REM -- POPUP CALCULATOR
REM -- <c> Fred Buffington 1994-1998. All rights reserved.freeware
REM -- email: oasys@nstar.net
REM -- originally and still used as a part of a subroutine (view.calc)
REM -- that was access by a function key or mouse click
REM -- Modified here to just show the calculator
REM -- If you use View calc as a sub change the goto end.of.it to
REM -- EXIT SUB
REM -- also included is a box drawing routine and an input routine
REM -- using inkey$

DECLARE FUNCTION zinkey$ ()
DECLARE SUB box (start.l%, col%, ecol%, wth%, lines%, btyp%, new.box%, from.view%)
       clr1% = 15: clr2% = 1: clr3% = 14: clr4% = 4
       COLOR clr1%, clr2%: CLS
VIEW.CALC:
        ZZ$ = "": xinp% = 0
      
        VCALC% = -1: VPAY% = 0: vcoa% = 0
        VSYN% = 0: VEMP% = 0: VPAY% = 0
        dulc = 201: dllc = 200: dhor = 205: dVERT = 186: durc = 187: dlrc = 188
        dulc$ = CHR$(dulc): durc$ = CHR$(durc)

        COLOR clr3%, clr4%
        start.l% = 14
        col% = 28: start.l% = 11: wth% = 22: ecol% = 51: lines% = 5: btyp% = 2
        box start.l%, 28, 51, 22, 5, 2, new.box%, from.view%
        box start.l% + 1, 29, 50, 20, 1, 2, -1, -1
        LOCATE start.l% + 4, col% + 1: PRINT SPACE$(wth%);
        count = 1
        LOCATE start.l%, col% + 3: COLOR clr3%, clr4%: PRINT "[POPUP CALCULATOR]";
        LOCATE start.l% + lines% + 1, col% + 5, 1, 0, 7: PRINT " Esc = EXIT "
        msg1$ = "Use * to multiply, / to divide, - to subtract, C=Clear, Alt-P=Paste Total"
        msg2$ = "Use * to multiply, / to divide, - to subtract, C=Clear"
        IF xfld% <> 5 THEN msg$ = msg2$ ELSE msg$ = msg1$
        LOCATE 23, 5: PRINT SPACE$(71);
        LOCATE 23, (80 - LEN(msg$)) / 2, 0, 1, 0: PRINT msg$;
        COLOR clr3%, clr4%
calc.in: IF total# * 10000 > -1 AND total# * 10000 < 1 THEN total# = 0
        COLOR clr3%, clr4%: LOCATE start.l% + 5, col% + 1: PRINT "Total = "; : PRINT USING "###,###,###.##"; total#;
        COLOR clr1%, clr2%: LOCATE start.l% + 2, col% + 2, 1, 0, 7: PRINT SPACE$(wth% - 2); : LOCATE start.l% + 2, col% + 2, 1, 0, 7: PRINT nbr$;
calc.in2: Z$ = zinkey$
        IF (Z$ = "*" OR Z$ = "/" OR Z$ = "\" OR Z$ = "-" OR Z$ = "+") AND (nbr$ = "*" OR nbr$ = "-" OR nbr$ = "/" OR nbr$ = "\" OR nbr$ = "+") THEN PRINT CHR$(7); : nbr$ = "": Z$ = "": GOTO calc.in2
        IF UCASE$(Z$) = "C" THEN
           'IF COUNT > 10 THEN COUNT = 10
           LL$(count) = STR$(total#) + " T"
           total# = 0: count = count + 1
           COLOR clr3%, clr4%: LOCATE start.l% + 5, col% + 11: PRINT USING "#########.##"; total#;
        END IF
        IF LEN(Z$) = 2 THEN
              IF xfld% = 5 AND ASC(MID$(Z$, 2, 1)) = 25 THEN VIEW$ = LTRIM$(STR$(total#)): GOTO end.of.it
              IF ASC(MID$(Z$, 1, 1)) = 0 AND (ASC(MID$(Z$, 2, 1)) >= 59 AND ASC(MID$(Z$, 2, 1)) <= 62) THEN count = 0: ZZ$ = Z$: RETURN
              Z$ = "": GOTO calc.in
        END IF
       ' IF ASC(Z$) = 24 THEN count = 0: GOTO VIEW.EMP
       ' IF ASC(Z$) = 4 THEN count = 0: GOTO VIEW.SYN
        IF ASC(Z$) = 27 THEN total# = 0: GOTO end.of.it
        IF ASC(Z$) >= ASC("0") AND ASC(Z$) <= ASC("9") THEN
            COLOR clr1%, clr2%: nbr$ = nbr$ + Z$: LOCATE start.l% + 2, col% + 2: PRINT SPACE$(wth% - 4); : LOCATE start.l% + 2, col% + 2, 1, 0, 7: PRINT nbr$; : COLOR clr3%, clr4%: GOTO calc.in
        END IF
        IF (Z$ = "*" OR Z$ = "/" OR Z$ = "\" OR Z$ = "-" OR Z$ = "+") AND nbr$ = "" THEN
                COLOR clr1%, clr2%: nbr$ = Z$: LOCATE start.l% + 2, col% + 2, 1, 0, 7: PRINT nbr$; : COLOR clr3%, clr4%: GOTO calc.in
        END IF
        IF Z$ = "." THEN nbr$ = nbr$ + ".": COLOR clr1%, clr2%: LOCATE start.l% + 2, col% + 2, 1, 0, 7: PRINT nbr$: GOTO calc.in
        IF Z$ = "," THEN Z$ = ""
        IF Z$ = CHR$(13) THEN
            TEST$ = MID$(nbr$ + SPACE$(1), 1, 1)
            IF TEST$ = "*" OR TEST$ = "+" OR TEST$ = "/" OR TEST$ = "-" THEN
                nbr$ = MID$(nbr$ + SPACE$(2), 2, LEN(nbr$) - 1): Z$ = TEST$
            END IF
            IF nbr$ = "" THEN LL$(count) = " ": count = count + 1
        END IF
        IF nbr$ <> "" AND (Z$ = "+" OR Z$ = CHR$(13)) THEN
            LL$(count) = nbr$: total# = total# + VAL(LL$(count)): IF Z$ <> CHR$(13) THEN LL$(count) = LL$(count) + Z$
            IF Z$ = CHR$(13) THEN nbr$ = ""
            count = count + 1
        END IF
        IF Z$ = "-" AND nbr$ <> "" THEN
            LL$(count) = nbr$: total# = total# - VAL(LL$(count)): LL$(count) = LL$(count) + Z$
            count = count + 1
        END IF
        IF (Z$ = "/" OR Z$ = "\") AND nbr$ <> "" THEN
            LL$(count) = nbr$: IF VAL(nbr$) <> 0 THEN total# = total# / VAL(LL$(count)): LL$(count) = LL$(count) + Z$
            count = count + 1
        END IF
        IF Z$ = "*" AND nbr$ <> "" THEN
            LL$(count) = nbr$: total# = total# * VAL(LL$(count)): LL$(count) = LL$(count) + Z$
            count = count + 1
        END IF
        IF Z$ = "." OR Z$ = "+" OR Z$ = "-" OR Z$ = "*" OR Z$ = "/" THEN nbr$ = Z$
        IF count > 9 THEN
            FOR R = 2 TO 9
                 LL$(R - 1) = LL$(R)
            NEXT R
            count = 9
        END IF
        COLOR clr3%, clr4%
        LOCATE start.l% - count + 1, col% + 1: PRINT CHR$(dulc); CHR$(dhor); "[POPUP CALCULATOR]"; CHR$(dhor); CHR$(durc); " ";
        XSTART.L% = start.l% - count + 1
        FOR k = 1 TO count - 1
             LOCATE XSTART.L% + k, col% + 1
             PRINT CHR$(dVERT); RIGHT$(SPACE$(22) + LL$(k), 20); CHR$(dVERT);
        NEXT k
        COLOR clr1%, clr2%: LOCATE start.l% + 2, col% + 3: PRINT SPACE$(wth% - 4); : LOCATE start.l% + 2, col% + 2: 'COLOR CLR3%, CLR4%
        nbr$ = ""
        VIEW PRINT
        GOTO calc.in
        RETURN
end.of.it:
'eliminate the following statements if u put this in a sub   
        CLOSE
        SYSTEM
        STOP

DEFINT A-Z
SUB box (start.l%, col%, ecol%, wth%, lines%, btyp%, new.box%, from.view%) STATIC
SHARED clr1%, clr2%, clr3%, clr4%
          IF clr2% = 0 AND clr3% = 0 THEN cm$ = "N"
          ulc = 218: llc = 192: lrc = 217: urc = 191: VERT = 179: hor = 196
          dulc = 201: dllc = 200: dhor = 205: dVERT = 186: durc = 187: dlrc = 188
          IF wth% < 40 THEN btyp% = 1
2060      IF btyp% = 1 THEN ulc$ = CHR$(ulc): urc$ = CHR$(urc): v$ = CHR$(VERT)
          IF btyp% = 1 THEN hor$ = CHR$(hor): llc$ = CHR$(llc): lrc$ = CHR$(lrc)
          IF btyp% = 2 THEN ulc$ = CHR$(dulc): urc$ = CHR$(durc): llc$ = CHR$(dllc)
          IF btyp% = 2 THEN lrc$ = CHR$(dlrc): hor$ = CHR$(dhor): v$ = CHR$(dVERT)
2070 REM -- to test altern box BTYP% = 1 : ULC$ = "" : URC$ = "" : GOTO 4357
'          IF wth% < 40 THEN ulc$ = " ": urc$ = " ": hor$ = " ": v$ = " ": llc$ = " ": lrc$ = " "
          VIEW PRINT
'          IF wth% < 60 THEN
'             COLOR CLR3%, clr4%
'          END IF
          LOCATE start.l%, col%: PRINT ulc$; STRING$(wth%, hor$); urc$;
          IF wth% = 5 THEN COLOR 15, 7: LOCATE start.l%, col% + 1: PRINT STRING$(wth%, hor$); : COLOR 0, 7
          'LOCATE start.l%, ecol%: PRINT urc$;
          FOR j = start.l% + 1 TO start.l% + lines%
                 LOCATE j, col%: PRINT v$; : LOCATE j, ecol%: PRINT v$;
                 IF wth% > 70 AND j = start.l% + 2 AND j < 5 THEN LOCATE j, col% + 1: PRINT STRING$(wth%, hor$);
                 IF wth% <= 20 THEN LOCATE j, col% + 1: PRINT SPACE$(wth%);
          NEXT
    '      LOCATE start.l%, col% + 1: PRINT STRING$(wth%, hor$);
'          IF wth% > 70 AND start.l% < 5 THEN
'              LOCATE start.l% + 2, col% + 1: PRINT STRING$(wth%, 196); v$; : 'rv$
'          END IF
        
          IF wth% < 70 THEN XA$ = llc$ + STRING$(wth%, hor$) + lrc$ ELSE XA$ = v$ + STRING$(wth%, CHR$(177)) + v$
          '' v$ + CHR$(27) + STRING$(wth% - 2, CHR$(177)) + CHR$(26) + v$
          LOCATE start.l% + lines% + 1, col%: PRINT XA$;
          ''STRING$(wth%, xb$); xc$;
          IF cm$ <> "N" THEN COLOR clr2%, 0 ELSE COLOR clr3%, 0
          IF wth% < 60 AND new.box% <> 99 THEN
            COLOR clr2%, 0
            FOR j = start.l% + 1 TO start.l% + lines%
               IF lines% > 1 THEN LOCATE j, ecol% + 1: PRINT "  ";
            NEXT
          END IF
          IF wth% < 40 OR (start.l% + lines% > 21 AND lines% < 18) THEN
                COLOR clr3%, clr4%
          ELSE
                COLOR clr1%, clr2%
          END IF
2171
2172      IF wth% < 60 AND lines% > 1 AND new.box% <> 99 THEN
             IF k < 32 THEN k = 32
             IF KK < 32 THEN KK = 32
             IF cm$ <> "N" THEN COLOR clr2%, 0 ELSE COLOR clr3%, 0
''            xyz = SCREEN(start.l% + lines% + 2, col% + 2, 1)
''            IF xyz MOD 16 = clr3% AND cm$ <> "N" THEN
''                COLOR clr4%, 0
''            END IF
REM ** tried above and works good for some colors but decided to put it back       
             LOCATE start.l% + lines% + 1, ecol% + 1
             PRINT "  "; : 'CHR$(k); CHR$(KK);
2173         FOR mm = col% + 2 TO ecol% + 2
                k = SCREEN(start.l% + lines% + 2, mm)
                IF k < 32 THEN k = 32
                IF start.l% + lines% + 2 < 24 THEN LOCATE start.l% + lines% + 2, mm: PRINT CHR$(k);
             NEXT mm
             COLOR clr1%, clr2%
          END IF
          IF wth% > 70 AND lines% > 10 AND lines% < 15 THEN
            COLOR clr1%, 0
            LOCATE start.l% + lines% + 2, col% + 2: PRINT SPACE$(wth% - 2);
            COLOR clr1%, clr2%
          END IF

END SUB

DEFSNG A-Z
FUNCTION zinkey$
DEFINT A-Z
WHILE ZIN$ = "": ZIN$ = INKEY$: WEND
zinkey$ = ZIN$

END FUNCTION