Announcement

**Michael Mattias** · 17 Oct 2008, 10:04 AM

Have not seen it myself but.....
- Petzold's book included a calculator app
- All the Petzold apps were ported to PB by someone
- Those ported apps were at one time and probably still are available here (files section?)

**Michael Mattias** · 17 Oct 2008, 10:39 AM

Oops, my bad....

> example ABS(SQR(FRAC(x)))

You want an expression evaluator, not a calculator.

I think ThinBasic (interpreter created with PB) will do that. Search here for that, also for 'expression' and/or
'interpreter'

MCM

**Rodney Hicks** · 17 Oct 2008, 11:02 AM

Well, not just an expression calculator, but a calculator with all the regular features plus the PB functions and capable of handling expressions. Similar to the Windows calculator Scientific format with the PB functions added.

**Scott Turchin** · 17 Oct 2008, 11:09 AM

Ya might look at Microsoft's PowerToy Programmable calculator - it's pretty awesome - does all of that..

Look in the downloads for XP Powertoys...

It's a single executable, lightweight -

**Erich Schulman** · 17 Oct 2008, 12:48 PM

Although not PB-specific, something like http://www.allersoft.com/allercalc.htm might be useful.

**Eddy Van Esch** · 17 Oct 2008, 02:33 PM

Rodney,

Have you looked at Daniel Corbiers calculator ?
http://www.ucalc.com/

Kind regards

**Rodney Hicks** · 17 Oct 2008, 03:15 PM

Haven't studied that uCalc, no, but it looks like it might be a tad more useful than what I had in mind.

I want to be sure that I'm getting answers with PB functions as opposed to some of the others, just in case they use slightly different methods. uCalc does look like it might do the trick though.

The reason I brought this up is that while coding, I very often find myself in need of a calculator for several different reasons, and one thing that I find missing is a quick look at some of the PB function, to make sure I understand what it does under certain circumstances, before I rack my neurons on the code.

But I will take a look at that a little deeper.
Either that or put it in the queue for the back burner.

Thanks for the responses.

**Gafny Jacob** · 17 Oct 2008, 04:10 PM

Try this
http://www.powerbasic.com/support/pb...ad.php?t=24616

**Rodney Hicks** · 17 Oct 2008, 04:27 PM

I wonder why I didn't see that thread when I searched. I guess because it's called an evaluator.

It may not be what I need, but it is definitely a good starting point. I see have to do some find and replace to get it working, but it sure looks like it has some good stuff in it.

Thanks.

**Eros Olmi** · 18 Oct 2008, 03:56 AM

http://www.jose.it-berater.org/smffo...sg2815#msg2815

**Rodney Hicks** · 18 Oct 2008, 05:33 AM

Thanks Eros.
I've downloaded and will peruse it to see if it's what I'm looking for.

**Cliff Nichols** · 18 Oct 2008, 11:02 AM

Eros posted exactly what I was thinking AWESOME job by the way Eros

I was playing around with it, trying to understand the work that you and Florent Heyworth have done in the past with this excellent code.

One thing I have not figured out, is how to call a function from a dll via your scripting engine. Although I have another way of doing it, it would greatly improve techniques if I could do it your way.

**Walt Thompson** · 18 Oct 2008, 02:58 PM

Updated Evaluator

Here's a slightly updated version of the Evaluator.

The update consisted of changing the name of variable: numeric to numeral.

NUMERIC is a key (reserved?) word in PB9. Apparently it was not in PB7.

Many Thanks to Gafny and Erik for providing this tool.

Code:

' Further improved math expression evaluator for PBWin70.
'
' This version of the math parser or interpreter includes more functions
' and error checking.
' Using extended precision, 18 digits of precision is obtained. Factorials
' up to 1754! can be handled without overflow. A number of constants
' and conversions are available, making this math evaluator an advanced
' scientific calculator. You can easily add your own functions, constants
' and conversions to the source code. Input of angles can be in degrees and
' radians. However, trigonometric output using the ARC functions will
' always be in radians. You can transform angles to radians and vice versa
' using the built-in conversions. Input of your math expression can be done
' using the keyboard or by clicking the items in the list boxes.
' Expressions and functions should be entered strictly according to standard
' algebraic syntax rules. Operators and expressions which can be used are:
' + - * / \ ^ ! ( ) < = > <> >= <= in addition to those shown
' in the list box.
' The Operator Precedence follows as closely as possible that used by
' PowerBasic - see the section on "Operator Precedence" in the PowerBasic
' help file. The only exception is the unary negation operator which in this
' program does not have a special priority following exponentiation.
' However, operations inside parentheses always have the highest
' priority and are always evaluated first. Thus by using parentheses in the
' right places you can always obtain the operator precedence you need for
' your purpose.
' The following operator precedence is used in the program:
' 1. parentheses ( )
' 2. unary operators (Factorials (!) )
' 3. one argument functions
' 4. exponentiation (^) (power expressions)
' 5. multiplication (*) and floating-point division (/)
' 6. integer division (\)
' 7. modulo (MOD)
' 8. addition (+), subtraction (-)
' 9. relational operators (<, <=, =, >=, >, <> )
' 10. NOT, ISFALSE and ISTRUE
' 11. AND
' 12. OR and XOR (exclusive OR)
' 13. EQV (equivalence)
' 14. IMP (implication)

' Many thanks to Gafny Jacob, who provided the original code, which have
' been considerably changed and improved. Thanks to Achilles B. Mina
' for free to use code concerning conversions and constants. Thanks
' to Tony Burcham and Gunar Zagars for valuable contributions
' concerning error checking and overflow indication. Also many thanks to
' the whole PowerBasic forum for great inspiration.
'
' Good luck! -- August 17, 2003 -- Erik Christensen -- [email protected]
' NB: Important improvement made June 10 and June 29, 2005



#COMPILE EXE
#REGISTER NONE
#DIM ALL
'
%FORM1_CLEAREXPRESSION  = 90
%FORM1_BUTTONDOANALYSIS = 100
%FORM1_BUTTONHELP       = 103
%FORM1_BUTTONABOUT      = 106
%FORM1_BUTTONEXIT       = 110
%FORM1_TEXTRESULTS      = 120
%FORM1_TEXTFORMULA      = 130
%FORM1_LABEL            = 140
%FORM1_LABEL2           = 150
%FORM1_LABEL3           = 155
%FORM1_LABEL4           = 157
%FORM1_DESCRIBE         = 160
%FORM1_LISTBOX1         = 170
%FORM1_LISTBOX2         = 172
%LabelRadioButtonAction = 175
%RadioButtonRadians     = 180
%RadioButtonDegrees     = 185
%HelpText               = 190
%HelpExitButton         = 195
'
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
'
GLOBAL gOldSubClassEdit&
GLOBAL hForm1&, hHelpForm&,hList2&,hTxt1&   ' handles
GLOBAL ListFlag AS LONG
GLOBAL Trig() AS STRING
GLOBAL CheckArr() AS STRING
GLOBAL FirstTime  AS LONG
GLOBAL ErrorTxt AS STRING
GLOBAL ErrorMes AS STRING
GLOBAL Extra() AS STRING, NoEx AS LONG
GLOBAL CF AS SINGLE
'
FUNCTION FindMatch(InString AS STRING) AS LONG
   LOCAL Cntr AS LONG
   LOCAL Pl   AS LONG
   DO WHILE pl <= LEN(InString)
      INCR Pl
      IF (MID$(InString, Pl, 1) = ")") THEN DECR Cntr
      IF (MID$(InString, Pl, 1) = "(") THEN INCR Cntr
      IF (MID$(InString, Pl, 1) = ")") AND ISFALSE Cntr THEN
         FUNCTION = pl
         EXIT DO
      END IF
   LOOP
END FUNCTION
'

FUNCTION Factorial(InVal AS LONG) AS EXT
   LOCAL i  AS LONG
   LOCAL r  AS EXT
   r = 1
   FOR i = 2 TO InVal
      r = r * i
   NEXT
   FUNCTION = r
END FUNCTION
'
FUNCTION Eval(Formula AS STRING) AS EXT
   LOCAL InString   AS STRING
   LOCAL checkStr   AS STRING
   LOCAL EndPl      AS LONG
   LOCAL Tmp        AS STRING
   LOCAL Expr       AS STRING
   LOCAL SaveExpr   AS STRING
   LOCAL ExprVal    AS EXT
   LOCAL Owner      AS STRING
   LOCAL LastDigit  AS LONG
   LOCAL LastDigOld AS LONG
   LOCAL Ex         AS LONG
   LOCAL Dp         AS LONG
   LOCAL RitWingLen AS LONG
   LOCAL InStrLen   AS LONG
   LOCAL p          AS LONG
   LOCAL Plc        AS LONG
   LOCAL pp         AS LONG
   LOCAL Mp         AS LONG
   LOCAL Mm         AS LONG
   LOCAL PExp       AS LONG
   LOCAL MExp       AS LONG
   LOCAL Padd       AS LONG
   LOCAL Psub       AS LONG
   LOCAL BEGIN      AS LONG
   LOCAL Sign       AS LONG
   LOCAL pMod       AS LONG
   LOCAL RemoveFlag AS LONG
   LOCAL ValidVal   AS LONG

   LOCAL LftWing    AS STRING
   LOCAL RitWing    AS STRING
   LOCAL RitWingval AS EXT
   LOCAL X          AS EXT
   LOCAL LftWingval AS EXT
   LOCAL Pl         AS LONG
   LOCAL Valid      AS STRING
   LOCAL digit      AS STRING
   LOCAL i          AS LONG
   LOCAL Result     AS EXT
   LOCAL Numeral    AS STRING
   LOCAL TicTac     AS LONG
   LOCAL l          AS LONG
   LOCAL De         AS STRING
   LOCAL Block      AS STRING
   LOCAL Mult       AS LONG
   LOCAL Div        AS LONG
   LOCAL IDiv       AS LONG
   LOCAL P1         AS LONG
   LOCAL P2         AS LONG
   LOCAL P3         AS LONG
   LOCAL P4         AS LONG
   LOCAL P5         AS LONG
   LOCAL P6         AS LONG
   '
   Instring = Formula
   '
   IF ISTRUE FirstTime THEN ' Check and "re-shape" expression string to facilitate evaluation.
       '
     '  Instring = UCASE$(Formula)
     '  Instring = REMOVE$(Instring," ")
       IF Instring = "" THEN ErrorMes = "Empty expression! - You need to enter an expression." : GOTO ExitOnError
       '
       ' 1. Check for unknown words in CheckStr (copy of InString)
       CheckStr = InString
       ' remove known words
       LOCAL ccc&, ttt$
       FOR i = 1 TO UBOUND(CheckArr)
           ttt$ = CheckArr(i)
           ccc& = INSTR(ttt$,"()")
           IF ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1) : GOTO hop2
           ccc& = INSTR(ttt$," ")
           IF ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
          hop2:
           CheckStr = REMOVE$(CheckStr,ttt$)
       NEXT
       LOCAL k1&,k2&
       ' locate unknown words or characters
       FOR i = 1 TO LEN(CheckStr)
           IF INSTR("0123456789ED.-+*/\^!()=<>", MID$(CheckStr,i,1)) = 0 THEN
               IF k1&=0 THEN k1& = i : k2& = i
               IF k1&>0 THEN k2& = i
           END IF
       NEXT
       IF k1&>0 THEN ErrorMes = "Cannot understand this: " + MID$(CheckStr,k1&,k2&-k1&+1) + " Please correct. "  : GOTO ExitOnError
       '
       ' 2. Check syntax.
       ' This part is heavily inspired by a fine code by Tony Burcham. Thank you.
       CheckStr = InString
       REPLACE "PI#" WITH "1.1" IN CheckStr  ' Temporary replacememt
       REPLACE "E#" WITH  "11"  IN CheckStr  ' Temporary replacememt
       ' Replace function name letters with F and logical functions with L
       FOR i = 1 TO UBOUND(CheckArr)
           ttt$ = CheckArr(i)
           ccc& = INSTR(ttt$,"()")
           IF ISTRUE ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
           IF INSTR(CheckStr,ttt$) THEN REPLACE ttt$ WITH STRING$(LEN(ttt$),"F") IN CheckStr
       NEXT
       FOR i = 1 TO UBOUND(CheckArr)
           ttt$ = CheckArr(i)
           ccc& = INSTR(ttt$," ")
           IF ISTRUE ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
           IF INSTR(CheckStr,ttt$) THEN REPLACE ttt$ WITH STRING$(LEN(ttt$),"L") IN CheckStr
       NEXT
       ' Make map string and detect any bad characters
       REPLACE ANY "0123456789ED-/\^" WITH "##########EE+***" IN CheckStr
       LOCAL posi&,Er&
       i = VERIFY(CheckStr,"#.+*EFL()<>=!")
       IF i THEN ErrorMes = "Illegal character: " + MID$(Instring,i,1) + "  Please correct. "  : GOTO ExitOnError
       ' Scan for illegal sequences
       LOCAL bad AS STRING, pc&
       'bad = " () (* )F )E )# +) +* +E *) ** *E F) F+ F* F. F# FE .( .. .F .E #( #F E( E) E* EF E. EE !# F! L) L+ L* L. LE .L EL L!"
       bad = "()(*)F)E)#+)+*+E*)***EF)F+F*F.F#FE.(...F.E#(#FE(E)E*EFE.EE!#F!L)L+L*L.LE.LELL!" 'compressed version of above
       FOR i = 1 TO LEN(bad) STEP 2
           pc = INSTR(CheckStr, MID$(bad,i,2))
           IF pc THEN ErrorMes = "Illegal character sequence: " + MID$(Instring,pc,2) + "  Please correct. "  : GOTO ExitOnError
       NEXT
       ' check end of string
       IF INSTR("+*FEL", RIGHT$(CheckStr, 1 )) THEN ErrorMes = "Illegal last character: " + RIGHT$(Instring,1) + "  Please correct. "  : GOTO ExitOnError
       ' since "*+" and "++" are allowed, we have
       ' to check for operator triplets
       REPLACE "*" WITH "+" IN CheckStr
       pc = INSTR(CheckStr, "+++")
       IF pc THEN ErrorMes = "Illegal character sequence: " + MID$(Instring,pc,3) + "  Please correct. "  : GOTO ExitOnError
       '
       ' checking OK, so continue to prepare expression for parsing
       REPLACE "PI#" WITH "3.14159265358979324" IN Instring
       REPLACE "E#" WITH "2.71828182845904524" IN Instring
       '
       REPLACE "LN" WITH "LOG" IN Instring  ' LOG is used for LN in the parsing
       '
       REPLACE "LOG10" WITH "CLG" IN Instring ' to avoid confusing numbers
       REPLACE "LOG2" WITH "TLG" IN Instring ' to avoid confusing numbers
       REPLACE "EXP10" WITH "ETE" IN Instring ' to avoid confusing numbers
       REPLACE "EXP2" WITH "ETO" IN Instring ' to avoid confusing numbers
       REPLACE "MOD" WITH CHR$(254) IN InString
       '
       'if
       '
       REPLACE "XOR" WITH CHR$(222) IN Instring ' to avoid confusion with OR
       REPLACE "OR" WITH CHR$(223) IN Instring ' to avoid confusion with XOR
       REPLACE "NOT" WITH CHR$(247) IN Instring
       REPLACE "ISTRUE" WITH CHR$(215) IN Instring
       REPLACE "ISFALSE" WITH CHR$(182) IN Instring
       '
       REPLACE "<>" WITH CHR$(174) IN Instring  ' one-character code for <>
       REPLACE "><" WITH CHR$(174) IN Instring
       REPLACE ">=" WITH CHR$(169) IN Instring  ' one-character code for >=
       REPLACE "=>" WITH CHR$(169) IN Instring
       REPLACE "<=" WITH CHR$(167) IN Instring  ' one-character code for <=
       REPLACE "=<" WITH CHR$(167) IN Instring

       '
       FirstTime = %FALSE
   END IF
   '
   ' Check parentheses
   IF TALLY(InString, "(") <> TALLY(InString, ")") THEN ErrorMes = "Parentheses mismatch" : GOTO ExitOnError
   '
   ' Priority 1.
   ' Evaluate parentheses ( )
   ' Evaluate each parenthesis in turn.
   DO
      Plc = INSTR(1 + Plc, InString, "(") ' find left parenthesis
      IF Plc THEN
        EndPl = FindMatch(MID$(InString, Plc)) ' find matching right parenthesis
        IF EndPl = 2 THEN ErrorMes = "Empty parenthesis" : GOTO ExitOnError
        SaveExpr = MID$(InString, Plc + 1, EndPl - 2) ' Expression in between
        Owner = LTRIM$(STR$(VAL(SaveExpr),18))
        IF (SaveExpr = Owner) OR (SaveExpr = "+" & Owner) OR (SaveExpr = Owner + "!" ) THEN ' this part fully evaluated or just needs calculation of factorial
            IF RIGHT$(SaveExpr,1) = "!" THEN Owner = Owner +"!" ' Keep any ! sign for proper evaluation of Factorial
            InString = LEFT$(InString, Plc - 1) & Owner & MID$(InString, Plc + EndPl)
        ELSE                                                   ' this part not fully evaluated
            ExprVal = Eval(SaveExpr)                           ' evaluate expression - recursive call
            ' insert evaluated part in proper place
            InString = LEFT$(InString, Plc - 1) & LTRIM$(STR$(ExprVal,18)) & MID$(InString, Plc + EndPl)
        END IF
      ELSE
        EXIT DO
      END IF
   LOOP
   '
   ' Remove multiple signs which may occur after evaluation of parentheses.
   REPLACE "++" WITH "+" IN Instring
   REPLACE "-+" WITH "-" IN Instring
   REPLACE "+-" WITH "-" IN Instring
   REPLACE "--" WITH "+" IN Instring
   '
   Tmp = LTRIM$(STR$(VAL(InString),18))
   '
   ' Finished or not ?
   IF (Tmp = InString) OR ("+" & Tmp = InsTring) GOTO ExitOk
    '
    ' Priority 2.
    ' Evaluate UNARY operators
    '
    ' calculate factorials
    DO
       Pl = INSTR(InString, "!")
       IF Pl THEN
          RitWing = MID$(InString, Pl + 1)
          GOSUB GetLeftWing
          IF LftWingVal <> FIX(LftWingVal) THEN ErrorMes = "Invalid factorial argument: Non integer." : GOTO ExitOnError
          IF ABS(LftWingVal) > 1754 THEN ErrorMes = "Factorial argument too large." : GOTO ExitOnError
          LOCAL flg3& : flg3 = 1
          IF LftWingVal < 0 THEN LftWingVal = ABS(LftWingVal) : flg3 = -1
          LOCAL FAC## : FAC## = Factorial##(CLNG(LftWingVal)) * flg3
          InString = LftWing & LTRIM$(STR$(FAC##,18)) & RitWing
          LftWing = "": RitWing = ""
       ELSE
          EXIT DO
       END IF
    LOOP
   '
   ' Priority 3:
   ' Calculate built-in and some extra one argument functions:
   '
   ' Angles measured in degrees ?
   LOCAL res&
   CONTROL SEND hForm1&,%RadioButtonDegrees,%BM_GETCHECK,0,0 TO res&
   '
   FOR i = 1 TO UBOUND(Trig)
      DO
        Pl = INSTR(InString, Trig(i))
        IF Pl THEN
          LftWing = LEFT$(InString, Pl - 1) ' string prior to function
          Pl = Pl + LEN(Trig(i)) - 1 ' place at start of argument
          '
          GOSUB GetRightWing : X = RitWingVal ' Get argument
          '
          ' If Angles measured in degrees - then transform to radians (only for non-inverse trig functions).
          ' Inverse trig-(ARC)functions will always be returned in radians.
          IF res&=%BST_CHECKED AND i<= 22 AND i>=12 THEN X = X * 1.74532925199432958E-2
          '
          SELECT CASE i
            CASE 1: Result = LOG(X + SQR(X * X + 1))                                      ' ARCSINH
            CASE 2: IF X < 1 THEN ErrorMes = "Argument outside range for ARCCOSH" :GOTO ExitOnError
                    IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCOSH. Will give overflow" :GOTO ExitOnError
                    Result = LOG(X + SQR(X * X - 1))                                      ' ARCCOSH
            CASE 3: IF ABS(X)>=1 THEN ErrorMes = "Argument outside range for ARCTANH" :GOTO ExitOnError
                    Result = LOG((1 + X) / (1 - X)) / 2                                   ' ARCTANH
            CASE 4: IF (X<=0 OR X>1) THEN ErrorMes = "Argument outside range for ARCSECH" :GOTO ExitOnError
                    Result = LOG((SQR(-X * X + 1) + 1) / X)                               ' ARCSECH
            CASE 5: IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCSCH. Will give overflow" :GOTO ExitOnError
                    Result = LOG((SGN(X) * SQR(X * X + 1) + 1) / X)                       ' ARCCSCH
            CASE 6: IF ABS(X)<=1 THEN ErrorMes = "Argument outside range for ARCCOTH" :GOTO ExitOnError
                    Result = LOG((X + 1) / (X - 1)) / 2                                   ' ARCCOTH
            CASE 7: IF ABS(X)>1 THEN ErrorMes = "Argument outside range for ARCSIN" :GOTO ExitOnError
                    Result = ATN(X / SQR(-X * X + 1))                                     ' ARCSIN
            CASE 8: IF ABS(X)>1 THEN ErrorMes = "Argument outside range for ARCCOS" :GOTO ExitOnError
                    Result = -ATN(X / SQR(-X * X + 1)) + 1.57079632679489662              ' ARCCOS
            CASE 9: IF ABS(X)<1 THEN ErrorMes = "Argument outside range for ARCSEC" :GOTO ExitOnError
                    IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCSEC. Will give overflow" :GOTO ExitOnError
                    Result = ATN(X / SQR(X * X - 1)) + SGN(X - 1) * 1.57079632679489662   ' ARCSEC
            CASE 10:IF ABS(X)<1 THEN ErrorMes = "Argument outside range for ARCCSC" :GOTO ExitOnError
                    IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCSC. Will give overflow" :GOTO ExitOnError
                    Result = ATN(X / SQR(X * X - 1)) + (SGN(X) - 1) * 1.57079632679489662 ' ARCCSC
            CASE 11:Result = ATN(X) + 1.57079632679489662                                 ' ARCCOT
            CASE 12:IF ABS(X)>11356 THEN ErrorMes = "Argument too large for SINH. Will give overflow. " :GOTO ExitOnError
                    Result = (EXP(X) - EXP(-X)) / 2                  ' SINH
            CASE 13:IF ABS(X)>11356 THEN Result = SGN(X) : EXIT SELECT
                    Result = (EXP(X) - EXP(-X)) / (EXP(X) + EXP(-X)) ' TANH
            CASE 14:IF ABS(X)>11356 THEN Result = 0 : EXIT SELECT
                    Result = 2 / (EXP(X) + EXP(-X))                  ' SECH
            CASE 15:IF X=0 THEN ErrorMes = "Argument for CSCH is zero." :GOTO ExitOnError
                    Result = 2 / (EXP(X) - EXP(-X))                  ' CSCH
            CASE 16:IF X=0 THEN ErrorMes = "Argument for COTH is zero." :GOTO ExitOnError
                    IF ABS(X)>11356 THEN Result = SGN(X) : EXIT SELECT
                    Result = (EXP(X) + EXP(-X)) / (EXP(X) - EXP(-X)) ' COTH
            CASE 17:IF COS(X)=0 THEN ErrorMes = "SEC is not defined for this argument." :GOTO ExitOnError
                    Result = 1 / COS(X)                              ' SEC
            CASE 18:IF SIN(X)=0 THEN ErrorMes = "CSC is not defined for this argument." :GOTO ExitOnError
                    Result = 1 / SIN(X)                              ' CSC
            CASE 19:IF TAN(X)=0 THEN ErrorMes = "COT is not defined for this argument." :GOTO ExitOnError
                    Result = 1 / TAN(X)                              ' COT
            CASE 20:Result = SIN(X)
            CASE 21:Result = COS(X)
            CASE 22:Result = TAN(X)
            CASE 23:Result = ATN(X)
            CASE 24:IF X <= 0 THEN ErrorMes = "LN or LOG <= 0" : GOTO ExitOnError
                    Result = LOG(X)
            CASE 25:IF ABS(X)>11356 THEN ErrorMes = "Argument too large for EXP. Will give overflow. " :GOTO ExitOnError
                Result = EXP(X)
            CASE 26:IF X < 0 THEN ErrorMes = "Square Root < 0" :GOTO ExitOnError
                    Result = SQR(X)
            CASE 27:IF X <= 0 THEN ErrorMes = "LOG10 <= 0" :GOTO ExitOnError
                    Result = LOG10(X)
            CASE 28:Result = ABS(X)
            CASE 29:IF X <= 0 THEN ErrorMes = "LOG2 <= 0" :GOTO ExitOnError
                    Result = LOG2(X)
            CASE 30:Result = CEIL(X)
            CASE 31:Result = FIX(X)
            CASE 32:Result = FRAC(X)
            CASE 33:Result = SGN(X)
            CASE 34:IF ABS(X)>16383 THEN ErrorMes = "Argument too large for EXP2. Will give overflow. " :GOTO ExitOnError
                    Result = EXP2(X)
            CASE 35:IF ABS(X)>4932 THEN ErrorMes = "Argument too large for EXP10. Will give overflow. " :GOTO ExitOnError
                    Result = EXP10(X)
          END SELECT
          ' Update InString with result and reset helper variables.
          InString = LftWing + LTRIM$(STR$(Result,18)) + RitWing
          GOSUB CleanUpVar
        ELSE
          EXIT DO
        END IF
      LOOP
    NEXT
    '
    ' Priority 4:
    ' calculate exponentiation (^) (power expressions)
    DO
       Pl = INSTR(InString, "^")
       IF Pl = 1 THEN
           ErrorMes = "Missing left argument in power espression" : GOTO ExitOnError
       ELSEIF Pl > 1 THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          IF LftWingVal>1 AND ABS(RitWingVal*LOG(LftWingVal))>11356 THEN ErrorMes = "Arguments too large for exponentiation. Will give overflow." :GOTO ExitOnError
          IF LftWingVal<0 AND FRAC(RitWingVal)<>0 THEN ErrorMes = "Exponentiation problem: Negative root is not allowed with a non-integer exponent." :GOTO ExitOnError
          Block = LTRIM$(STR$(LftWingVal ^ RitWingVal,18))
          InString = LftWing & Block & RitWing
          IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk ' fully evaluated
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 5:
    ' Perform multiplication (*) and floating-point division (/)
    DO
       InStrLen = LEN(InString)
       Mult = INSTR(InString, "*") : IF ISFALSE Mult THEN Mult = InStrLen
       Div =  INSTR(InString, "/") : IF ISFALSE Div THEN Div = InStrLen
       Pl = MIN(Mult, Div)
       IF Pl = InstrLen THEN Pl = 0
       IF Pl = 1 THEN
           ErrorMes = "Missing left argument in multiplication (*) or floating-point division (/)" : GOTO ExitOnError
       ELSEIF Pl > 1 THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          IF Pl = Mult THEN
             IF LOG(ABS(LftWingVal)) + LOG(ABS(RitWingVal)) > 11356 THEN ErrorMes = "Arguments too large for multiplication. Will give overflow" :GOTO ExitOnError
             result = LftWingVal * RitWingVal
          ELSEIF Pl = Div THEN
             IF RitWingVal = 0 THEN ErrorMes = "Division by zero" : GOTO ExitOnError
             result = LftWingVal / RitWingVal
          END IF
          Block = LTRIM$(STR$(result,18))
          InString = LftWing & Block  & RitWing
          IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 6:
    ' Perform integer division (\)
    DO
       InStrLen = LEN(InString)
       Pl = INSTR(InString, "\")
       IF Pl = InstrLen THEN Pl = 0
       IF Pl = 1 THEN
           ErrorMes = "Missing left argument in integer division (\)" : GOTO ExitOnError
       ELSEIF Pl > 1 THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          IF RitWingVal = 0 THEN ErrorMes = "Integer Division by zero" : GOTO ExitOnError
          result = LftWingVal \ RitWingVal
          Block = LTRIM$(STR$(result,18))
          InString = LftWing & Block  & RitWing
          IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 7:
    ' Perform modulo (MOD) operation
    DO
       InStrLen = LEN(InString)
       Pl = INSTR(InString, CHR$(254))
       IF Pl = InstrLen THEN Pl = 0
       IF Pl = 1 THEN
           ErrorMes = "Missing left argument in MOD expression" : GOTO ExitOnError
       ELSEIF Pl > 1 THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          IF RitWingVal = 0 THEN ErrorMes = "Division by zero in MOD expression" : GOTO ExitOnError
          result = LftWingVal MOD RitWingVal
          Block = LTRIM$(STR$(result,18))
          InString = LftWing & Block  & RitWing
          IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 8:
    ' Perform addition (+) and subtraction (-)
    '
    DO
       PExp = 2: MExp = 1: InstrLen = LEN(InString)
PlusFind:
       PAdd = INSTR(PExp, InString, "+")
       IF Padd THEN
          De = MID$(InString, PAdd - 1, 1)
          IF (De = "D") OR (De = "E") THEN
             PExp = Padd + 1
             GOTO PlusFind
          END IF
       ELSE
          PAdd = InstrLen
       END IF
'
MinusFind:
       INCR TicTac
       IF TicTac = InstrLen + 1 GOTO RelationalOp
       PSub = INSTR(MExp, InString, "-")
       IF Psub = 1 THEN
          IF LEN(STR$(VAL(InString),18)) = InstrLen GOTO ExitOk
          MExp = 2
          GOTO MinusFind
       END IF
       IF PSub THEN
          De = MID$(InString, PSub - 1, 1)
          IF De < "0" OR De > "9" THEN
             MExp = PSub + 1
             GOTO MinusFind
          END IF
       ELSE
          Psub = InstrLen
       END IF
       Pl = MIN(PAdd, PSub)
       IF Pl = InstrLen THEN Pl = 0
       IF Pl THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          IF Pl = PAdd THEN
             Result = LftWingVal + RitWingVal
          ELSEIF Pl = PSub THEN
             result = LftWingVal - RitWingVal
          END IF
          TicTac = 0
          Block = LTRIM$(STR$(Result,18))
          InString = LftWing & Block & RitWing
          IF Block = InString OR InString = "-1=-1" THEN GOSUB CleanUpVar : GOTO ExitOk
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 9:
    ' Evaluate relational operators (<, <=, =, >=, >, <> )
    '
RelationalOp:
    DO
       InStrLen = LEN(InString)
       P1 = INSTR(InString, "=") : IF P1 = 0 THEN P1 = InStrLen
       P2 = INSTR(InString, ">") : IF P2 = 0 THEN P2 = InStrLen
       P3 = INSTR(InString, "<") : IF P3 = 0 THEN P3 = InStrLen
       '
       P4 = INSTR(InString, CHR$(174)) : IF P4 = 0 THEN P4 = InStrLen ' <>
       P5 = INSTR(InString, CHR$(169)) : IF P5 = 0 THEN P5 = InStrLen ' >=
       P6 = INSTR(InString, CHR$(167)) : IF P6 = 0 THEN P6 = InStrLen ' <=
       '
       Pl = MIN(P1, P2, P3, P4, P5, P6)
       IF Pl = InStrLen THEN EXIT DO
       IF Pl = 1 THEN
           ErrorMes = "No left argument in relational expression" : GOTO ExitOnError
       ELSEIF Pl > 1 THEN
          GOSUB GetLeftWing : GOSUB GetRightWing
          SELECT CASE Pl
             CASE P1 : Result = LftWingVal = RitWingVal
             CASE P2 : Result = LftWingVal > RitWingVal
             CASE P3 : Result = LftWingVal < RitWingVal
             CASE P4 : Result = LftWingVal <> RitWingVal
             CASE P5 : Result = LftWingVal >= RitWingVal
             CASE P6 : Result = LftWingVal <= RitWingVal
          END SELECT
          Block = LTRIM$(STR$(Result,18))
          InString = LftWing & Block & RitWing
          IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
       ELSE
          EXIT DO
       END IF
    LOOP
    '
    ' Priority 10:
    ' Evaluate NOT, ISFALSE and ISTRUE
    LOCAL Pnot&,Pisfalse&,Pistrue&
    DO
      InStrLen = LEN(InString)
      Pnot =  INSTR(InString, CHR$(247)) : IF Pnot =  0 THEN Pnot =  InStrLen
      Pisfalse = INSTR(InString, CHR$(182)) : IF Pisfalse = 0 THEN Pisfalse = InStrLen
      Pistrue = INSTR(InString, CHR$(215)) : IF Pistrue = 0 THEN Pistrue = InStrLen
      Pl = MIN(Pnot, Pisfalse, Pistrue)
      IF Pl = InStrLen THEN EXIT DO
      IF Pl THEN
         GOSUB GetRightWing
         IF Pl = Pnot THEN
            result = NOT RitWingVal
         ELSEIF Pl = Pisfalse THEN
            result = ISFALSE RitWingVal
         ELSEIF Pl = Pistrue THEN
            result = ISTRUE RitWingVal
         END IF
         InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
         LftWing = "": Numeral = "": RitWing = ""
      ELSE
         EXIT DO
      END IF
    LOOP

    ' Priority 11:
    ' Evaluate AND
    DO
      Pl = INSTR(InString, "AND")
      IF Pl = 1 THEN
          ErrorMes = "No left argument in AND expression" : GOTO ExitOnError
      ELSEIF Pl > 1 THEN
         GOSUB GetLeftWing
         Pl = Pl + 2
         GOSUB GetRightWing
         Result = LftWingVal AND RitWingVal
         InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
         LftWing = "": Numeral = "": RitWing = ""
      ELSE
         EXIT DO
      END IF
    LOOP
'   '
    ' Priority 12:
    ' Evaluate OR and XOR (exclusive OR)
    LOCAL Por&,Pxor&
    DO
      InStrLen = LEN(InString)
      Por =  INSTR(InString, CHR$(223)) : IF Por =  0 THEN Por =  InStrLen
      Pxor = INSTR(InString, CHR$(222)) : IF Pxor = 0 THEN Pxor = InStrLen
      Pl = MIN(Por, Pxor)
      IF Pl = InStrLen THEN EXIT DO
      IF Pl = 1 THEN
          ErrorMes = "No left argument in OR or XOR expression" : GOTO ExitOnError
      ELSEIF Pl > 1 THEN
         GOSUB GetLeftWing : GOSUB GetRightWing
         IF Pl = Por THEN
            result = LftWingVal OR RitWingVal
         ELSEIF Pl = Pxor THEN
            result = LftWingVal XOR RitWingVal
         END IF
         InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
         LftWing = "": Numeral = "": RitWing = ""
      ELSE
         EXIT DO
      END IF
    LOOP
    '
    ' Priority 13:
    ' Evaluate EQV (equivalence)
    DO
      Pl = INSTR(InString, "EQV")
      IF Pl = 1 THEN
          ErrorMes = "No left argument in EQV expression" : GOTO ExitOnError
      ELSEIF Pl > 1 THEN
         GOSUB GetLeftWing
         Pl = Pl + 2
         GOSUB GetRightWing
         Result = LftWingVal EQV RitWingVal
         InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
         LftWing = "": Numeral = "": RitWing = ""
      ELSE
         EXIT DO
      END IF
    LOOP
    '
    ' Priority 14:
    ' Evaluate IMP (implication)
    DO
      Pl = INSTR(InString, "IMP")
      IF Pl = 1 THEN
          ErrorMes = "No left argument in IMP expression" : GOTO ExitOnError
      ELSEIF Pl > 1 THEN
         GOSUB GetLeftWing
         Pl = Pl + 2
         GOSUB GetRightWing
         Result = LftWingVal IMP RitWingVal
         InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
         LftWing = "": Numeral = "": RitWing = ""
      ELSE
         EXIT DO
      END IF
    LOOP
'
'
ExitOk:
   FUNCTION = VAL(InString)
   ErrorTxt = ""
   EXIT FUNCTION
'
ExitOnError:
   ErrorTxt = "   Error in Expression: " + ErrorMes
   FUNCTION = 0
   EXIT FUNCTION
'
'
GetLeftWing:
   ' Get left wing and left argument
   Valid = "1234567890.-+DE"
   BEGIN = Pl
   DO
      ValidVal = 1
      DECR BEGIN
      P = INSTR(Valid, MID$(InString, BEGIN, 1))
      IF P THEN
         IF ((P = 12) _         ' -
            OR (P = 13)) _      ' +
            AND (Sign = 0) _    ' no sign yet
            AND (BEGIN > 1) _
            THEN
               IF INSTR("1234567890.", MID$(InString, BEGIN - 1, 1)) THEN ' ~ if not D or E
                  ValidVal = 0: INCR BEGIN
               END IF
               Sign = -1        ' Sign flag true
         ELSEIF (P = 14) _      ' D
            OR (P = 15) _       ' E
            THEN
                Sign = 0: Valid = "1234567890.-+"  ' D and E no more valid
         ELSEIF P > 11 THEN
            ValidVal = 0
            IF Sign THEN INCR BEGIN
         END IF
      ELSE
         ValidVal = 0: INCR BEGIN
      END IF
   LOOP WHILE (ValidVal = 1) AND (BEGIN > 1)
   LftWing = LEFT$(InString, BEGIN - 1)                  ' left wing prior to LftWingVal
   LftWingVal = VAL(MID$(InString, BEGIN, Pl - BEGIN))   ' left wing value
   IF Pl = BEGIN THEN ErrorMes = "Invalid left argument" : GOTO ExitOnError
   RETURN
'
'
GetRightWing:
   ' Get right wing and right argument
   RitWing = MID$(InString, Pl + 1)  ' right wing
   IF LEN(RitWing) <= 0 THEN ErrorMes = "No right argument" : GOTO ExitOnError
   RitWingVal = VAL(RitWing) ' Value of (first part of) right wing
   IF RitWing = LTRIM$(STR$(RitWingVal,18)) THEN ' fully evaluated
      RitWing = ""
      GOTO FinishRightBlock
   END IF
   LastDigit = 1: LastDigOld = 0: EX = 0: DP = 0
   RitWingLen = LEN(RitWing)
   DO WHILE LastDigit <= RitWingLen
       Digit = MID$(RitWing, LastDigit, 1)
       IF LastDigit = 1 THEN ' sign position
          IF INSTR("+-", Digit) THEN
            IF (SGN(RitWingVal) = 1) AND (Digit = "+") THEN
               INCR LastDigit
            ELSEIF (SGN(RitWingVal) = -1) AND (Digit = "-") THEN
               INCR LastDigit
            ELSE
               EXIT DO
            END IF
          END IF
       END IF
       ' Get valid number
       IF INSTR("1234567890", Digit) THEN
          INCR LastDigit
       ELSEIF Digit = "." THEN
          IF Dp = 0 THEN INCR LastDigit: Dp = 1
       ELSEIF INSTR("DE", Digit) THEN
          IF Ex = 0 THEN INCR LastDigit: Ex = 1
       ELSEIF (INSTR("+-", Digit) <> 0) AND (INSTR("DE", MID$(RitWing, MAX(1, LastDigit - 1), 1)) <> 0) THEN
          INCR LastDigit
       END IF
       IF LastDigit = LastDigOld THEN EXIT DO
       LastDigOld = LastDigit
   LOOP
   RitWing = MID$(RitWing, LastDigit)
'
FinishRightBlock:
   P = 0
   BEGIN = P
   Sign = P
   LastDigit = P
   LastDigOld = P
   RitWingLen = P
   Ex = P
   Dp = P
   Valid = ""
   Digit = ""
   RETURN
'
CleanUpVar:
   LftWing = "": Numeral$ = "": RitWing = ""
   RitWingVal = 0: Result = 0 : X = 0
   LftWingVal = 0
   Block = ""  : De = ""
   RETURN

END FUNCTION ' Eval
'
CALLBACK FUNCTION CBF_HelpExit
    DIALOG END hHelpForm&
END FUNCTION
' ------------------------------------------------
SUB ShowHelpText(BYVAL hForm1&) ' make and display help form
    LOCAL tt AS STRING
    tt="This latest improved version of the math parser or interpreter includes a better interphase, more facilities, and more functions "+ _
    "as well as error checking. "+$CRLF+$CRLF+ _
    "By performing the calculations using extended-precision floating-point numbers, 18 digits of precision is obtained. Factorials "+ _
    "up to 1754! can now be handled without overflow. "+$CRLF+$CRLF+ _
    "A number of constants "+ _
    "and conversions are available, making this math evaluator an advanced "+ _
    "scientific calculator. Constants can stand alone, but conversions should always be preceeded by a number or numerical expression to work correctly."+$CRLF+$CRLF+ _
    "You can easily add your own functions, constants "+ _
    "and conversions to the source code."+$CRLF+$CRLF+ _
    "Input of angles can be in degrees and "+ _
    "radians. However, trigonometric output using the ARC functions will "+ _
    "always be in radians, but you can always transform angles to radians and vice versa "+ _
    "using the built-in conversions."+$CRLF+$CRLF+ _
    "Input of your math expression can be done "+ _
    "using the keyboard or by clicking the items in the list boxes. "+$CRLF+$CRLF+ _
    "Expressions and functions should be entered strictly according to standard "+ _
    "algebraic syntax rules. Operators and expressions which can be used are:  "+ _
    "+  - *  /  \  ^  !  (  )  <  =  >  <>  >=  <=  in addition to those shown "+ _
    "in the large list box. "+$CRLF+$CRLF+ _
    "The Operator Precedence follows as closely as possible that used by PowerBasic - see the section on ""Operator Precedence"" in the PowerBasic help file. "+ _
    "The only exception is the unary negation operator which in this program does not have a special priority following exponentiation. "+ _
    "However, operations inside parentheses always have the highest priority and are always evaluated first. "+ _
    "Thus by using parentheses in the right places you can always obtain the operator precedence you need for your purpose. "+$CRLF+$CRLF+ _
    "The following operator precedence is used: "+$CRLF+ _
    "1.  parentheses ( )"+$CRLF+ _
    "2.  unary operators (factorials (!) )"+$CRLF+ _
    "3.  one argument functions"+$CRLF + _
    "4.  exponentiation (^) (power expressions)"+$CRLF + _
    "5.  multiplication (*) and floating-point division (/)"+$CRLF + _
    "6.  integer division (\)"+$CRLF + _
    "7.  modulo (MOD)"+$CRLF + _
    "8.  addition (+), subtraction (-)"+$CRLF + _
    "9.  relational operators (<, <=, =, >=, >, <> )"+$CRLF + _
    "10. NOT, ISFALSE and ISTRUE"+$CRLF + _
    "11. AND"+$CRLF + _
    "12. OR and XOR (exclusive OR)"+$CRLF+ _
    "13. EQV (equivalence)"+$CRLF + _
    "14. IMP (implication)"+$CRLF+$CRLF+ _
    "Many thanks to Gafny Jacob, who provided the original code, which has "+ _
    "been considerably changed and improved. Thanks to Achilles B. Mina "+ _
    "for free to use code concerning conversions and constants. Thanks "+ _
    "to Tony Burcham and Gunar Zagars for valuable contributions "+ _
    "concerning error checking and overflow indication. Also many thanks to "+ _
    "the whole PowerBasic forum for great inspiration. "+$CRLF+$CRLF+ _
    "Good luck! -- June 29, 2005 -- Erik Christensen -- [email protected]"
    LOCAL Style&
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER
    DIALOG NEW hForm1&, "Math Evaluator Help", , , 300*CF, 200*CF, Style&,  TO hHelpForm&
    CONTROL ADD BUTTON, hHelpForm&, %HelpExitButton,  "E&xit", 260*CF, 184*CF, 37*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_HelpExit
    CONTROL ADD TEXTBOX, hHelpForm&, %HelpText,tt, 3*CF, 3*CF, 294*CF,176*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR %ES_READONLY OR %ES_LEFT OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
    CONTROL SET COLOR hHelpForm&,%HelpText, RGB(0,0,255), RGB(255,255,255)
    CONTROL SEND hHelpForm&,%HelpText,%WM_SETFONT,GetStockObject(%SYSTEM_FONT),%TRUE
    DIALOG SHOW MODAL hHelpForm&
END SUB
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTONHELP
    CALL ShowHelpText(hForm1&)
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_FORM1_BUTTONABOUT
    LOCAL St AS STRING
    St="Math expression evaluator with built-in constants and conversions for PBWin70. Program version 1.41   -   June 29, 2005"+$CRLF+$CRLF+ _
    "By Erik Christensen, Copenhagen, Denmark       [email protected]"+$CRLF+$CRLF+ _
    "The use of this Public Domain program and its consequences are your own responsibility. However, any comment you may have is welcome."+$CRLF+$CRLF+ _
    "Good Luck!"
    MSGBOX St,%MB_ICONINFORMATION,"About this program"
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
END FUNCTION
'
CALLBACK FUNCTION SubClassEditKeys
    ' Subclass callback function for processing key messages in edit control (textbox).
    SELECT CASE CBMSG
        CASE %WM_GETDLGCODE
            FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
        CASE %WM_CHAR    ' Any character key at time of pressing
            SELECT CASE CBWPARAM   ' Holds the code of the key.
                ' Specify what action should be taken for each key code.
                CASE 65 TO 90, 97 TO 122 ' character signs A-Z and a-z
                    LOCAL txt$,Res&
                    txt$ = UCASE$(CHR$(CBWPARAM))
                    IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN
                        ' If SHIFT is pressed while character key is
                        ' pressed, then scroll listbox to show items
                        ' beginning with that character.
                        ' (This is better than using "GetAsyncKeyState")
                        LOCAL flag& : flag = 0
                        DO  ' This loop serves to scroll to item just above any
                            ' missing first letter in the list box, e.g. J at present.
                            CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SELECTSTRING,-1, STRPTR(txt$) TO Res&
                            IF Res& = %LB_ERR THEN txt$ = CHR$(ASC(txt$)+1) : flag = 1 ' First letter missing - move on to next letter
                        LOOP UNTIL Res&<>%LB_ERR OR txt$ >= "Z"
                        IF Res&<>%LB_ERR THEN CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SETTOPINDEX,Res& - flag,0
                        CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SETCURSEL,-1,0  ' deselect any item
                        ListFlag = 1 ' set flag for removing this character from expression textbox.
                    END IF
                CASE %VK_RETURN ' 13 ' ENTER pressed
                    ListFlag = 0
                    CALL analysis
                    EXIT FUNCTION
                CASE ELSE ' No action to be taken here for the other keys.
                    ListFlag = 0
            END SELECT
        CASE ELSE
            ListFlag = 0
    END SELECT
    ' Pass the message on to the original window procedure... the DDT engine!
    FUNCTION = CallWindowProc(gOldSubClassEdit&, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION
'
CALLBACK FUNCTION CBF_FORM1_CLEAREXPRESSION
    CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, ""
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
    FUNCTION = %TRUE
END FUNCTION
'
CALLBACK FUNCTION CBF_FORM1_BUTTONDOANALYSIS
    CALL analysis
    FUNCTION = %TRUE
END FUNCTION
'
CALLBACK FUNCTION CBF_FORM1_BUTTONEXIT
    LOCAL res&
    res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
    IF res&=%IDYES THEN DIALOG END hForm1&
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
END FUNCTION
'
SUB analysis
    STATIC t AS STRING,t1 AS SINGLE,t2 AS SINGLE
    LOCAL hCtl&,t3$,ii&, i&, k&
    LOCAL Test$,LineCount&,FirstVisLine&,Res&,NN AS EXT
    STATIC Number&, NotFirst&
    '
    ' Added June 10, 2005
    DIM OpLog(1 TO 8) AS STATIC STRING
    IF ISFALSE NotFirst THEN
        DATA "NOT","ISFALSE","ISTRUE","AND","OR","XOR","EQV","IMP"
        FOR i = 1 TO 8
            OpLog(i) = READ$(i)
        NEXT
        NotFirst& = %TRUE
    END IF
    '
    FirstTime = %TRUE
    CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,0,-1  ' select all text
    CONTROL GET TEXT hForm1&, %FORM1_TEXTFORMULA TO Test$

'    CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,0,-1
'    CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,-1,0  ' deselect all text. Put caret at the end

        INCR Number&
        t = t + "Evaluation "+STR$(Number&)+$CRLF
       ' t1 = TIMER ' START TIME
        t = t + "Expression:  " + Test$
        '
        ' Replace text with numeric expressions for conversions or constants
        FOR ii& = 0 TO NoEx
            IF INSTR(Test$,Extra(0,ii&)) THEN
                REPLACE Extra(0,ii&) WITH Extra(1,ii&) IN Test$
                Test$ = REMOVE$(Test$," ")
                REPLACE "**" WITH "*" IN Test$
            END IF
        NEXT
        '
        ' insert extra parentheses to ensure correct evaluation of logical expressions (June 10, 2005)
        Test$ = UCASE$(Test$)
        Test$ = REMOVE$(Test$," ")
        Test$ = "(" + Test$ + ")"
        FOR i = 1 TO 8
            k = 1
            DO
                k = INSTR(k, Test$, OpLog(i))
                IF ISTRUE k THEN Test$ = STRINSERT$(Test$, "(", k + LEN(OpLog(i))) : Test$ = STRINSERT$(Test$, ")", k) : k = k + 3
            LOOP UNTIL ISFALSE k
        NEXT
        '
        Test$ = REMOVE$(Test$, "()")  ' added June 29, 2005
        t3$ = STR$(Eval(Test$),18)
        t = t + ErrorTxt + $CRLF
        IF ErrorTxt ="" THEN
            t = t + "Result:  " + t3$ + $CRLF + $CRLF
        ELSE
            t = t + $CRLF + $CRLF
        END IF
      '  t2 = TIMER ' END TIME
      '  t = t + "Evaluation time in ms: "+FORMAT$(1000 * (t2 - t1),"####")+$CRLF
      '  t = t + $CRLF
        t = RIGHT$(t, 65535) ' To avoid exceding the capacity limit of the multiline textbox
        CONTROL SET TEXT hForm1&,%FORM1_TEXTRESULTS,t
        CONTROL HANDLE hForm1&, %FORM1_TEXTRESULTS TO hCtl&
        LineCount&=Edit_GetLineCount(hCtl&)
        FirstVisLine&=Edit_GetFirstVisibleLine(hCtl&)
        ' scroll down to last evaluation
        Res&=Edit_LineScroll(hCtl&,0,LineCount&-FirstVisLine&-5)
        CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
END SUB
'
CALLBACK FUNCTION CallbackListbox
    LOCAL CVal&, text$ ,text2$
    LOCAL hEdit AS LONG
    LOCAL lpStart AS LONG, lpEnd AS LONG
    IF CBCTLMSG=%LBN_SELCHANGE THEN
        ' Get first and last position of the selection if any
        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
        CONTROL GET TEXT hForm1&,%FORM1_TEXTFORMULA TO text$
        ' Return Current Selection in CVal&
        CVal&=-1
        CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
        IF CVal& > -1 THEN ' valid selection
            LISTBOX GET TEXT CBHNDL , CBCTL TO text2$
            LOCAL cc&
            cc& = INSTR(text2$," ")
            IF cc& THEN text2$=LEFT$(text2$,cc&-1)
            cc&=0
            IF INSTR(text2$,"()") THEN cc&=1
            CONTROL SEND CBHNDL, CBCTL,%LB_SETCURSEL,-1,0
            text$=LEFT$(text$,lpStart)+text2$+MID$(text$,lpStart+1)
            CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, text$
            CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,0,lpStart+LEN(text2$)-cc&
            CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,-1,0
            CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
            FUNCTION = %TRUE
        END IF
    END IF
END FUNCTION
'
CALLBACK FUNCTION CallbackListbox2
    LOCAL CVal&, text$ ,text2$
    LOCAL hEdit AS LONG, le&
    LOCAL lpStart AS LONG, lpEnd AS LONG
    IF CBCTLMSG=%LBN_SELCHANGE THEN
        ' Get first and last position of the selection if any
        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
        CONTROL GET TEXT hForm1&,%FORM1_TEXTFORMULA TO text$
        ' Return Current Selection in CVal&
        CVal&=-1
        CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
        IF CVal& > -1 THEN ' valid selection
            LISTBOX GET TEXT CBHNDL, CBCTL TO text2$
            text2$ = TRIM$(text2$)
            CONTROL SEND CBHNDL, CBCTL,%LB_SETCURSEL,-1,0
            text$=LEFT$(text$,lpStart)+text2$+MID$(text$,lpStart+1)
            CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, text$
            CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,0,lpStart+LEN(text2$)
            CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,-1,0
            CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
            FUNCTION = %TRUE
        END IF
    END IF
END FUNCTION
' ------------------------------------------------
SUB SizeListbox(BYVAL hDlg&,BYVAL id&,BYVAL Xp&,BYVAL Yp&,BYVAL W&,BYVAL H&,BYVAL UNflag&)
    ' Resize LISTBOX while maintaining integral line height.
    ' The built-in behavior of listbox is not satisfactory
    ' when switching to and from horizontal scroll bar. Therefore,
    ' the %LBS_NOINTEGRALHEIGHT style should be applied, so we
    ' can control the whole process. The %WS_HSCROLL and %WS_VSCROLL
    ' styles are also necessary.
    STATIC t$
    LOCAL I&,j&,TotalWidth&,Temp$,nResult&,nCount&,hDC&
    LOCAL TotalHeight&,hCtr&,VS&,HS&
    LOCAL rc AS RECT
    LOCAL Si AS APISIZE
    LOCAL hFont AS LONG
    LOCAL VScrollBarWidth&,HScrollBarHeight&,ListboxItemHeight&
    IF UNflag& THEN ' convert dialog units to pixels
        DIALOG UNITS hDlg&, Xp&, Yp& TO PIXELS Xp&, Yp&
        DIALOG UNITS hDlg&, W&, H& TO PIXELS W&, H&
    END IF
    CONTROL HANDLE hDlg&, id& TO hCtr&
    ListboxItemHeight&  = SendMessage(hCtr&,%LB_GETITEMHEIGHT,0,0)
    VScrollBarWidth&  = GetSystemMetrics(%SM_CXVSCROLL)
    HScrollBarHeight& = GetSystemMetrics(%SM_CYHSCROLL)
    '
    ' Find maximum width string to determine if a horizontal scroll bar is needed.
    ' Lance Edmonds is thanked for his example in the source code forum.
    nCount = 1
    hDC = GetDC(hCtr&)
    hFont = SendMessage(hCtr&, %WM_GETFONT, 0, 0)
    IF hFont THEN hFont = SelectObject(hDC, hFont)
    j = SendMessage(hCtr&, %LB_GETCOUNT, 0, 0)
    TotalHeight& = j * ListboxItemHeight& ' Total height of listbox content.
    ' Enumerate the strings in the LISTBOX
    FOR i = 0 TO j - 1
      nResult = SendMessage(hCtr&,%LB_GETTEXTLEN, i, 0)
      IF nResult THEN
        Temp = SPACE$(nResult)
        SendMessage hCtr&, %LB_GETTEXT, i, STRPTR(Temp)
        ' Get the width of the string. Addition of "N" provides a safety margin.
        GetTextExtentPoint32 hDC, BYCOPY Temp + "N", nResult + 1, Si
        ' Get the maximum width.
        nCount = MAX&(nCount, Si.cx)
      END IF
    NEXT i
    ' Set horizontal extent of the listbox. If this is larger than
    ' listbox's physical width, a horizontal scroll bar is sutomatically added.
    SendMessage hCtr&, %LB_SETHORIZONTALEXTENT, nCount, 0
    ' Clean up
    IF hFont THEN SelectObject hDC, hFont
    ReleaseDC hCtr&, hDC
    '
    TotalWidth& = nCount
    '
    ' Assess if scrollbars will be displayed and make proper adjustments:
    IF H& < TotalHeight& + HScrollBarHeight& THEN VS& = 1 ' Vertical scroll bar dependent on horizontal scroll bar
    IF H& < TotalHeight& THEN VS& = VScrollBarWidth&      ' Vertical scroll bar certain
    IF W& - 2 * GetSystemMetrics(%SM_CXEDGE)< TotalWidth& + VScrollBarWidth& THEN HS& = 1   ' Horizontal scroll bar dependent on vertical scroll bar
    IF W& - 2 * GetSystemMetrics(%SM_CXEDGE)< TotalWidth& THEN HS& = HScrollBarHeight&      ' Horizontal scroll bar certain
    IF HS& = HScrollBarHeight& AND VS& = 1 THEN VS& = VScrollBarWidth&
    IF VS& = VScrollBarWidth& AND HS& = 1 THEN HS& = HScrollBarHeight&
    IF VS& <= 1 AND HS& <= 1 THEN HS& = 0 AND VS& = 0
    H& = H& - HS&
    '
    H& = INT(H&/ListboxItemHeight&) * ListboxItemHeight& _ ' Get integral lines height
              + 2 * GetSystemMetrics(%SM_CYEDGE) + 1 _     ' Add edge height (may be improved)
              + HS&                                        ' Add horizontal scroll factor
    ' Set new position and size of listbox
    ' The following approach always going from larger to smaller width gives
    ' the best results.
    MoveWindow hCtr&,Xp&,Yp&,W&+VScrollBarWidth&,H&,%TRUE
    MoveWindow hCtr&,Xp&,Yp&,W&,H&,%TRUE
END SUB
'
CALLBACK FUNCTION EditFormulaProc
    LOCAL hCtl&,j&,Result&
    SELECT CASE CBMSG
        CASE %WM_INITDIALOG
            ' Resize LISTBOX while maintaining integral line height.
            CALL SizeListbox(hForm1&,%FORM1_LISTBOX1,140*CF,10*CF,248*CF,164*CF,1)
            InvalidateRect hForm1&, BYVAL %NULL , %TRUE
            UpdateWindow hForm1&
            CONTROL HANDLE hForm1&, %FORM1_TEXTFORMULA TO hCtl&
            gOldSubClassEdit& = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassEditKeys))
        CASE %WM_DESTROY
            ' Important! Remove the subclassing
            SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassEdit&
        CASE ELSE
    END SELECT
END FUNCTION
'
CALLBACK FUNCTION CallbackTextFormula
    LOCAL text$
    LOCAL lpStart AS LONG, lpEnd AS LONG

    ' If pressed keyboard character was meant to scroll listbox, then remove it from the expression.
    IF CBCTLMSG = %EN_CHANGE AND ListFlag = 1 THEN
        ' Get first and last position of the selection if any
        CONTROL SEND CBHNDL,CBCTL, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
        CONTROL GET TEXT CBHNDL, CBCTL TO text$
        ' Delete character just prior to caret.
        text$=LEFT$(text$,lpStart-1)+MID$(text$,lpStart+1)
        CONTROL SET TEXT CBHNDL, CBCTL, text$
        CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,lpStart-1,lpStart-1
        CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,-1,0  ' de-select text.
        ListFlag = 0
    END IF
    FUNCTION = %TRUE
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_RadioButtonRadians
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
    FUNCTION = %TRUE
END FUNCTION
' ------------------------------------------------
CALLBACK FUNCTION CBF_RadioButtonDegrees
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
    FUNCTION = %TRUE
END FUNCTION
' ----------------------------------------------------------------
FUNCTION PBMAIN()
    LOCAL tt$,ni&,t$,LogPixelsY&
    LOCAL hDC AS LONG
    LOCAL CC1 AS INIT_COMMON_CONTROLSEX     
      
    CC1.dwSize=SIZEOF(CC1)
    CC1.dwICC=%ICC_WIN95_CLASSES
    InitCommonControlsEX CC1
    'Retrieves a handle of a display device context (DC) for the
    'client area of the specified window (here the desktop).
    hDC = GetDC(%HWND_DESKTOP)
    '
    'Retrieves device-specific information about the number
    'of pixels per logical inch along the screen height
    '(depends on screen resolution setting).
    'This is important to define appropriate font sizes.
    'LogPixelsY = 120 for large fonts and 96 for small fonts setting of Windows
    LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
    CF = 1 ' dialog conversion factor for large fonts setting
    IF LogPixelsY = 96 THEN CF = 1.25 ' dialog conversion factor for small fonts setting
    LOCAL Style&,Exstyle&,LabelStyle&,DWstyle&,ListStyle&
    Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER' OR %WS_CLIPCHILDREN
    ExStyle& = 0
    LabelStyle& = %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT

    DIALOG NEW 0, "Math expression evaluator with built-in constants and conversions for PBWin9.0", 0, 0,  392*CF, 260*CF, Style&, ExStyle& TO hForm1&

    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL, "Enter expression using standard syntax:", 5*CF,168*CF,140*CF,12*CF, LabelStyle&
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL2, "Result of expression evaluation:", 5*CF,191*CF,159*CF,12*CF, LabelStyle&
    LOCAL tx$
    tx$ = "Easy Find:   SHIFT + First Letter    -    Then click to select:"
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL3, tx$, 142*CF,2*CF,248*CF,12*CF, LabelStyle&
    CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL4, "Click to select:", 5*CF,117*CF,134*CF,12*CF, LabelStyle&

    ListStyle&=%WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %WS_TABSTOP OR %LBS_SORT
    CONTROL ADD LISTBOX, hForm1&, %FORM1_LISTBOX1, , 140*CF,10*CF,248*CF,164*CF,ListStyle& OR %WS_HSCROLL OR %LBS_NOINTEGRALHEIGHT ,%WS_EX_CLIENTEDGE CALL CallbackListbox
    CONTROL SET COLOR hForm1&,%FORM1_LISTBOX1, RGB(0,0,225), RGB(255,255,230)
    CONTROL SEND hForm1&,%FORM1_LISTBOX1,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
    ListStyle& = ListStyle& - %LBS_SORT
    CONTROL ADD LISTBOX, hForm1&, %FORM1_LISTBOX2, , 3*CF,125*CF,134*CF,40,ListStyle& OR %LBS_MULTICOLUMN  ,%WS_EX_CLIENTEDGE CALL CallbackListbox2
    LOCAL cv&: cv=22: IF CF>1 THEN cv=21
    CONTROL SEND hForm1&, %FORM1_LISTBOX2, %LB_SETCOLUMNWIDTH, cv,0
    CONTROL SET COLOR hForm1&,%FORM1_LISTBOX2, RGB(0,0,225), RGB(255,255,230)
    CONTROL SEND hForm1&,%FORM1_LISTBOX2,%WM_SETFONT,GetStockObject(%SYSTEM_FONT),%TRUE
    DWstyle& = %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR %ES_READONLY OR %ES_LEFT OR %WS_TABSTOP

    CONTROL ADD TEXTBOX, hForm1&,%FORM1_DESCRIBE,"",3*CF,10*CF,134*CF,104*CF,DWstyle&,%WS_EX_CLIENTEDGE
    CONTROL SET COLOR hForm1&,%FORM1_DESCRIBE, RGB(230,0,0), RGB(255,240,255)
    CONTROL SEND hForm1&,%FORM1_DESCRIBE,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),%TRUE
    CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXTFORMULA,  "", 3*CF, 176*CF, 386*CF, 12*SQR(CF), _
        %ES_AUTOHSCROLL OR %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_UPPERCASE ,%WS_EX_CLIENTEDGE CALL CallbackTextFormula
    CONTROL SET COLOR hForm1&,%FORM1_TEXTFORMULA, RGB(0,0,225), RGB(255,255,255)

    CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
    CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXTRESULTS,  "", 3*CF, 199*CF, 386*CF, 40*CF, _
      %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR _
        %ES_LEFT OR %WS_VSCROLL OR %ES_NOHIDESEL OR %ES_AUTOVSCROLL OR %WS_TABSTOP, _
        %WS_EX_CLIENTEDGE
    CONTROL SET COLOR hForm1&,%FORM1_TEXTRESULTS, RGB(0,0,225), RGB(235,255,255)

    CONTROL SEND hForm1&,%FORM1_TEXTRESULTS,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
    '
    CONTROL ADD LABEL, hForm1&,  %LabelRadioButtonAction,  "Input Angles in:",5*CF,155*CF,48*CF,10*CF
    CONTROL ADD OPTION, hForm1&,  %RadioButtonRadians,  "Radians", 56*CF,154*CF,38*CF, 10*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON OR %WS_GROUP OR %WS_TABSTOP CALL CBF_RadioButtonRadians
    CONTROL ADD OPTION, hForm1&,  %RadioButtonDegrees,  "Degrees", 96*CF,154*CF,38*CF, 10*CF CALL CBF_RadioButtonDegrees
    CONTROL SEND hForm1&,%RadioButtonRadians,%BM_SETCHECK,%BST_CHECKED,0
    '
    CONTROL ADD BUTTON, hForm1&,  %FORM1_CLEAREXPRESSION,  "&Clear expression", 3*CF, 244*CF, 70*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_CLEAREXPRESSION
    CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONDOANALYSIS,  "&Evaluate expression", 78*CF, 244*CF, 180*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONDOANALYSIS
    CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONHELP,  "&Help", 264*CF, 244*CF, 34*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONHELP
    CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONABOUT,  "&About", 304*CF, 244*CF, 34*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONABOUT
    CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONEXIT,  "E&xit", 344*CF, 244*CF, 45*CF, 12*CF, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONEXIT
    '
    tt="Expressions and functions should be entered strictly according to standard "+ _
    "algebraic syntax rules. GIGO you know."+$CRLF+$CRLF+"Type or build expression by selecting its components in "+ _
    "the list boxes. "+ $CRLF+$CRLF+ "Good Luck!"+$CRLF+"Erik Christensen"+$CRLF+"[email protected]"
    CONTROL SET TEXT hForm1&,%FORM1_DESCRIBE,tt
    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA

    '
    DATA "ARCSINH() - Arc (Inverse) Hyperbolic Sine","ARCCOSH() - Arc (Inverse) Hyperbolic Cosine","ARCTANH() - Arc (Inverse) Hyperbolic Tangent","ARCSECH() - Arc (Inverse) Hyperbolic Secant"
    DATA "ARCCSCH() - Arc (Inverse) Hyperbolic Cosecant","ARCCOTH() - Arc (Inverse) Hyperbolic Cotangent","ARCSIN() - Arc (Inverse) Sine","ARCCOS() - Arc (Inverse) Cosine"
    DATA "ARCSEC() - Arc (Inverse) Secant","ARCCSC() - Arc (Inverse) Cosecant","ARCCOT() - Arc (Inverse) Cotangent","SINH() - Hyperbolic Sine","TANH() - Hyperbolic Tangent"
    DATA "SECH() - Hyperbolic Secant","CSCH() - Hyperbolic Cosecant","COTH() - Hyperbolic Cotangent","SEC() - Secant","CSC() - Cosecant"
    DATA "COT() - Cotangent","SIN() - Sine","COS() - Cosine","TAN() - Tangent","ATN() - Arc (Inverse) Tangent","LN() - Natural Log (base E)"
    DATA "EXP2() - Exponentiation of 2 or Antilog 2","EXP10() - Exponentiation of 10 or Antilog 10"
    DATA "EXP() - Exponentiation of E or Antilog E","SQR() - Square Root","LOG10() - Common Log (base 10)","ABS() - Absolute Value","LOG2() - Log (base 2)","LOG() - Natural Log (base E)"
    DATA "AND - Logical AND","XOR - Logical XOR (Exclusive OR)","OR - Logical OR","MOD - MOD (Modulo)","IMP - Logical IMP (Implication)"
    DATA "EQV - Logical EQV (Equivalence)","NOT - NOT","ISTRUE - Logical Truth","ISFALSE - Logical Falsity","CEIL() - Ceiling"
    DATA "FRAC() - Fractional Part","FIX() - Truncate To Integer","SGN() - Sign","PI# - Constant (3.14159..)","E# - Constant (2.71828..)","**1**"
    ' EXP must come after EXP2 and EXP10
    ' LOG must come after LOG2 and LOG10
    ni = 1
    LOCAL kk&
    DO WHILE READ$(ni) <> "**1**"
        t = READ$(ni)
        IF INSTR(t,"()") THEN
            t = t + " Function"
        ELSE
            IF INSTR(t,"#") THEN EXIT IF
            t = t + " Operator"
        END IF
        LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t
        REDIM PRESERVE CheckArr(ni)
        kk& = INSTR(t,"()")
        IF kk& THEN t = LEFT$(t,kk&-1)
        CheckArr(ni) = t
        INCR ni
    LOOP
    '
    DATA "1","+","2","-","3","*","4","/","5","\","6","^","7","("
    DATA "8",")","9","=","0","<",".",">","E","!","**2**"

    INCR ni
    DO WHILE READ$(ni) <> "**2**"
        t = READ$(ni)
        LISTBOX ADD hForm1&, %FORM1_LISTBOX2, "  "+t
        INCR ni
    LOOP
    '
    REDIM Extra(1,0)
    INCR ni
    NoEx=-1
    ' Read conversions
    DO WHILE READ$(ni) <> "**3**"
        INCR NoEx
        REDIM PRESERVE Extra(1,NoEx)
        t = UCASE$(READ$(ni))
        LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t + " - Conversion"
        Extra(0,NoEx) = t
        INCR ni
        Extra(1,NoEx) = READ$(ni)
        INCR ni
    LOOP
    '
    DATA "Foot_TO_meter"                                    , "*1/ 3.28084"
    DATA "Meter_TO_foot"                                    , "* 3.28084"
    DATA "Inch_TO_centimeter"                               , "* 2.54"
    DATA "Centimeter_TO_inch"                               , "*1 / 2.54"
    DATA "Kilometer_TO_mile"                                , "*1 / 1.609344"
    DATA "Mile_TO_kilometer"                                , "* 1.609344"
    DATA "Inch_TO_foot"                                     , "*1 / 12"
    DATA "Foot_TO_inch"                                     , "* 12"
    DATA "Yard_TO_meter"                                    , "*1 / 1.093613"
    DATA "Meter_TO_yard"                                    , "* 1.093613"
    DATA "Fathom_TO_meter"                                  , "* 1.8288"
    DATA "Meter_TO_fathom"                                  , "*1 / 1.8288"
    DATA "Mile_TO_light-year"                               , "*1 / 5880000000000"
    DATA "Light-year_TO_mile"                               , "* 5880000000000"
    DATA "Parsec_TO_light-year"                             , "* 3.261643"
    DATA "Light-year_TO_parsec"                             , "*1 / 3.261643"
    DATA "Square_ft_TO_square_m"                            , "*1 / 10.76391"
    DATA "Square_m_TO_square_ft"                            , "* 10.76391"
    DATA "Square_in_TO_square_cm"                           , "* 6.4516"
    DATA "Square_cm_TO_square_in"                           , "*1 / 6.4516"
    DATA "Hectare_TO_acre"                                  , "* 2.471054"
    DATA "Acre_TO_hectare"                                  , "*1 / 2.471054"
    DATA "Pound_TO_kilogram"                                , "*1 / 2.204623"
    DATA "Kilogram_TO_pound"                                , "* 2.204623"
    DATA "Ton_(metric)_TO_Kilogram"                         , "* 1000"
    DATA "Kilogram_TO_ton_(metric)"                         , "*1 / 1000"
    DATA "Ton_(US)_TO_Kilogram"                             , "* 907.18474"
    DATA "Kilogram_TO_ton_(US)"                             , "*1 / 907.18474"
    DATA "Ton_(UK)_TO_Kilogram"                             , "* 1016.046909"
    DATA "Kilogram_TO_ton_(UK)"                             , "*1 / 1016.046909"
    DATA "Ounce_(avoirdupois)_TO_gram"                      , "* 28.349551"
    DATA "Gram_TO_ounce_(avoirdupois)"                      , "*1 / 28.349551"
    DATA "Ounce_(troy)_TO_gram"                             , "* 31.103508"
    DATA "Gram_TO_ounce_(troy)"                             , "*1 / 31.103508"
    DATA "Fahrenheit_TO_Celsius"                            , "*1 / 1.8 - 32 / 1.8"
    DATA "Celsius_TO_Fahrenheit"                            , "* 1.8 + 32"
    DATA "Celsius_TO_Kelvin"                                , "*1 + 273.16"
    DATA "Kelvin_TO_Celsius"                                , "*1 - 273.16"
    DATA "Gallon_(US_dry)_TO_liter"                         , "* 4.404884"
    DATA "Liter_TO_gallon_(US_dry)"                         , "*1 / 4.404884"
    DATA "Gallon_(US_liquid)_TO_liter"                      , "* 3.785412"
    DATA "Liter_TO_gallon_(US_liquid)"                      , "*1 / 3.785412"
    DATA "Quart_(US_dry)_TO_gallon_(US_dry)"                , "*1 / 4"
    DATA "Gallon_(US_dry)_TO_quart_(US_dry)"                , "* 4"
    DATA "Pint_TO_liter_(US_dry)"                           , "* 0.55061"
    DATA "Liter_TO_pint_(US_dry)"                           , "*1 / 0.55061"
    DATA "Pint_TO_liter_(US_liquid)"                        , "* 0.473176"
    DATA "Liter_TO_pint_(US_liquid)"                        , "*1 / 0.473176"
    DATA "Cubic_ft_TO_cubic_m"                              , "*1 / 35.314667"
    DATA "Cubic_m_TO_cubic_ft"                              , "* 35.314667"
    DATA "Horsepower_(elec.)_TO_watt"                       , "* 745.7"
    DATA "Watt_TO_horsepower_(elec.)"                       , "*1 / 745.7"
    DATA "Horsepower_(metric)_TO_watt"                      , "* 735.499"
    DATA "Watt_TO_horsepower_(metric)"                      , "*1 / 735.499"
    DATA "BTU/hour_TO_watt"                                 , "* 0.293071"
    DATA "Watt_TO_BTU/hour"                                 , "*1 / 0.293071"
    DATA "Kilowatt_TO_watt"                                 , "* 1000"
    DATA "Watt_TO_kilowatt"                                 , "*1 / 1000"
    DATA "Kph_TO_mph"                                       , "*1 / 1.609344"
    DATA "Mph_TO_kph"                                       , "* 1.609344"
    DATA "Knot_TO_mph"                                      , "* 1.150778"
    DATA "Mph_TO_knot"                                      , "*1 / 1.150778"
    DATA "Meter/sec_TO_ft/sec"                              , "* 3.28084"
    DATA "Ft/sec_TO_meter/sec"                              , "*1 / 3.28084"
    DATA "Second_TO_minute"                                 , "*1 / 60"
    DATA "Minute_TO_second"                                 , "* 60"
    DATA "Minute_TO_hour"                                   , "*1 / 60"
    DATA "Hour_TO_minute"                                   , "* 60"
    DATA "Minute_TO_day"                                    , "*1 / 1440"
    DATA "Day_TO_minute"                                    , "* 1440"
    DATA "Day_TO_hour"                                      , "* 24"
    DATA "Hour_TO_day"                                      , "*1 / 24"
    DATA "Psi_TO_pascal"                                    , "* 6894.757"
    DATA "Pascal_TO_psi"                                    , "*1 / 6894.757"
    DATA "Psi_TO_atmosphere"                                , "* 0.068046"
    DATA "Atmosphere_TO_psi"                                , "*1 / 0.068046"
    DATA "Psi_TO_kg/sqcm"                                   , "* 0.070307"
    DATA "Kg/sqcm_TO_psi"                                   , "*1 / 0.070307"
    DATA "Degrees_TO_radians"                               , "* 1.74532925199432958E-2
    DATA "Radians_TO_degrees"                               , "*1 / 1.74532925199432958E-2
    ' **************************************
    ' You may insert other conversions here.
    ' **************************************
    DATA "**3**"
    '
    ' Read constants
    INCR ni
    DO WHILE READ$(ni) <> "**4**"
        INCR NoEx
        REDIM PRESERVE Extra(1,NoEx)
        t = UCASE$(READ$(ni))
        LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t + " - Constant"
        Extra(0,NoEx) = t
        INCR ni
        Extra(1,NoEx) = READ$(ni)
        INCR ni
    LOOP
    '
    DATA "Acceleration_of_gravity_(m/sec²)"                 , "9.80665"
    DATA "Dry_air_density_at_STP_(kg/m³)"                   , "1.293"
    DATA "Light_speed_in_a_vacuum_(m/sec)"                  , "299792458"
    DATA "Solar_constant_(watts/m²)"                        , "1340"
    DATA "Sound_speed_at_STP_(m/sec)"                       , "331.4"
    DATA "Standard_atmosphere_(nt/m²)"                      , "101300"
    DATA "Earth_equatorial_radius_(m)"                      , "6378000"
    DATA "Earth_escape_velcity_(m/sec)"                     , "11186"
    DATA "Earth_magnetic_dipole_moment_(amp-m²)"            , "6.400E21"
    DATA "Earth_mass_(kg)"                                  , "5.983E24"
    DATA "Earth_mean_angular_rotational_speed_(rads/sec)"   , ".0000729"
    DATA "Earth_mean_density_(kg/m³)"                       , "5522"
    DATA "Earth_mean_orbital_speed_(m/sec)"                 , "29770"
    DATA "Earth_polar_radius_(m)"                           , "6357000"
    DATA "Earth_volume_(m³)"                                , "1.087E21"
    DATA "Alpha_particle_mass_(kg)"                         , "6.64465598E-27"
    DATA "Electron_charge-mass_ratio_(coul/kg)"             , "175881961000"
    DATA "Electron_rest_mass_(kg)"                          , "9.10938188E-31"
    DATA "Muon_rest_mass_(kg)"                              , "1.88353109E-28"
    DATA "Neutron_rest_mass_(kg)"                           , "1.67492716E-27"
    DATA "Proton_rest_mass_(kg)"                            , "1.67262158E-27"
    DATA "Atomic_mass_constant_(kg)"                        , "1.66053873E-27"
    DATA "Avogadro_constant_(1/mole)"                       , "6.02214199E23"
    DATA "Boltzmann_constant_(joule/K)"                     , "1.3806503E-23"
    DATA "Elementary_charge_(coul)"                         , "1.602176462E-19"
    DATA "Faraday_constant_(coul/mole)"                     , "96485.3415"
    DATA "Gravitational_constant_(nt-m²/kg²)"               , ".000000000066726"
    DATA "Permeability_constant_(henry/m)"                  , "1.25663706143E-6"
    DATA "Permittivity_constant_(farad/m)"                  , "8.85418781762E-12"
    DATA "Planck_constant_(joule-sec)"                      , "6.62606876E-34"
    DATA "Rydberg_constant_(1/m)"                           , "10973731.568549"
    DATA "Stefan-Boltzmann_constant_(watt/m²K4)"            , ".000000056704"
    DATA "Universal_gas_constant_(joule/K-mole)"            , "8.314472"
    DATA "Wien_displacement_constant_(m-K)"                 , ".00290"
    ' ************************************
    ' You may insert other constants here.
    ' ************************************
    DATA "**4**"
    '
    REDIM Trig(35)
    Trig(1) = "ARCSINH"
    Trig(2) = "ARCCOSH"
    Trig(3) = "ARCTANH"
    Trig(4) = "ARCSECH"
    Trig(5) = "ARCCSCH"
    Trig(6) = "ARCCOTH"
    Trig(7) = "ARCSIN"
    Trig(8) = "ARCCOS"
    Trig(9) = "ARCSEC"
    Trig(10) = "ARCCSC"
    Trig(11) = "ARCCOT"
    Trig(12) = "SINH"
    Trig(13) = "TANH"
    Trig(14) = "SECH"
    Trig(15) = "CSCH"
    Trig(16) = "COTH"
    Trig(17) = "SEC"
    Trig(18) = "CSC"
    Trig(19) = "COT"
    Trig(20) = "SIN"
    Trig(21) = "COS"
    Trig(22) = "TAN"
    Trig(23) = "ATN"
    Trig(24) = "LOG" ' natural log or ln (logE)
    Trig(25) = "EXP"
    Trig(26) = "SQR"
    Trig(27) = "CLG" ' log10
    Trig(28) = "ABS"
    Trig(29) = "TLG" ' log2
    Trig(30) = "CEIL"
    Trig(31) = "FIX"
    Trig(32) = "FRAC"
    Trig(33) = "SGN"
    Trig(34) = "ETO" ' EXP2
    Trig(35) = "ETE" ' EXP10
    DIALOG SHOW MODAL hForm1& , CALL EditFormulaProc
END FUNCTION
' ------------------------------------------------

**Rodney Hicks** · 19 Oct 2008, 03:44 AM

All of the afore mentioned calculators have capabilities that are awesome, to say the least.

Thanks all for the leads.

Announcement

Is there a PB Calculator?

Is there a PB Calculator?

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment