Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Improved math expression evaluator for PB Windows 7.0

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Improved math expression evaluator for PB Windows 7.0

    ' 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 -- e.chr@email.dk
    ' NB: Important improvement made June 10 and June 29, 2005
    Code:
    #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 Numeric    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 = "": Numeric = "": 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 = "": Numeric = "": 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 = "": Numeric = "": 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 = "": Numeric = "": 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 = "": Numeric = "": 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 = "": Numeric$ = "": 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 -- e.chr@email.dk"
        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       e.chr@email.dk"+$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 PBWin70", 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+"e.chr@email.dk"
        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
    ' ------------------------------------------------


    [This message has been edited by Erik Christensen (edited June 29, 2005).]

  • #2
    A new markedly improved version is presented above. This will
    be the last version --- at least for a while.



    ------------------

    Comment


    • #3
      Originally posted by Erik Christensen:
      A new markedly improved version is presented above. This will
      be the last version --- at least for a while.

      Erik,
      Its a wonderful job!
      You might, however, reconsider the ASM error checking.
      Paul's idea was beautifully simple and should work, but it doesn't.
      This issue is discussed in this forum under 'FPU status register'.
      I have worked out how to check for errors before actually doing
      a calculation. For many calcs you can't actually check the outcome
      because that would itself potentially cause over or under flow.
      However, you can use the LOG of the numbers. Of course, the LOGS could be
      so huge as to overflow, but no one (?) would use such extreme numbers.
      You could, if really worried, take LOG(LOG)! (etc).
      See my parser which I have corrected and added additional checking too.
      Regards,
      Gunar



      ------------------

      Comment


      • #4
        Gunar,

        Thanks for your comment. I agree, prevention of overflow is
        better, especially if the cure is not working. Your method of
        using the log is elegant. So I adjusted the program on these
        issues. In the process I - naturally - found some other things
        to improve e.g. using GetKeyState instead of GetAsyncKeyState.

        I came to remember Thomas A. Edison’s saying: “There is always
        a way to do it better ... find it!”

        However, after all I think I need a pause with this program.

        Best regards,

        Erik



        ------------------


        [This message has been edited by Erik Christensen (edited March 05, 2003).]

        Comment


        • #5
          Some further improvements on this math parser or interpreter
          have been made.


          ------------------

          Comment


          • #6
            Hi,

            I've just tested this last version (August 2003).

            I got a problem with the "AND" operator :

            Evaluation 1
            Expression: 1 AND 74 < 71
            Result: 1 ---> Should be 0

            Evaluation 2
            Expression: 1 AND (74 < 71)
            Result: 0 ---> Ok

            Have-you got any new version of your math parser.
            Thank you for your help

            Jean-Pierre LEROY


            ------------------
            Jean-Pierre LEROY
            Cholet - France
            Jean-Pierre LEROY

            Comment


            • #7
              Jean-Pierre,

              Thanks for testing this code. I have corrected it to evaluate your
              (and other similar) expressions correctly. I would be grateful if
              you would test it again to its limits to find even other errors.
              Thank you.

              Best regards,

              Erik Christensen

              ------------------

              Comment


              • #8
                Erik,

                Thank you for the update of your code.

                I've tested it again ... so far so good !

                Thank you very much.

                Best regard,
                Jean-Pierre LEROY



                ------------------
                Jean-Pierre LEROY
                Cholet - France
                Jean-Pierre LEROY

                Comment


                • #9
                  ' Further improved math expression evaluator. Now updated for PBWin91.
                  '
                  ' 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!

                  Updated Version -- January 6, 2010 -- Erik Christensen
                  Code:
                  #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 Numerical    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 = "": Numerical = "": 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 = "": Numerical = "": 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 = "": Numerical = "": 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 = "": Numerical = "": 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 = "": Numerical = "": 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 = "": Numerical$ = "": 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! -- Latest Update January, 2010 -- Erik Christensen"
                      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 PBWin91. Program version 1.5   -   January 6, 2010"+$CRLF+$CRLF+ _
                      "By Erik Christensen, Copenhagen, Denmark"+$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 PBWin91", 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=19 ' : 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"
                      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
                  ' ------------------------------------------------

                  Comment


                  • #10
                    dear erik,

                    here's still something missing with declarations (for example: Edit_GetLineCount(hCtl&) )
                    see: Line 956/960, Error 519.
                    LineCount&=Edit_GetLineCount(hCtl&)
                    FirstVisLine&=Edit_GetFirstVisibleLine(hCtl&)
                    perhaps you can check it again for running with PBWIN 9, would be nice! thanks for your update, I like this idea of math. expression evaluator.
                    cannot compile your example, sorry. good evening, servus, frank

                    => last edit: thursday 7.jan.2010:

                    works here too, I have first installed new headers "win32api.inc" from josé roca's website, installed powerbasic again at other place at my machine with original "win32api.inc" so your application runs! don't know why it doesn't work with josé's headers, thanks a lot erik, I like your math. evaluation app!
                    best regards, frank
                    Last edited by frank bruebach; 7 Jan 2010, 10:37 AM.

                    Comment


                    • #11
                      Hi
                      It works for me. Thanks for the update

                      Eddy

                      Comment


                      • #12
                        Frank

                        The Edit_GetLineCount(hCtl&) and Edit_GetFirstVisibleLine(hCtl&) functions are in the COMMCTRL.INC include file. You need to include that file for the program to function.

                        Hope this helps.

                        Best regards,

                        Erik

                        P.S. Somehow you must have missed those functions originally.
                        Last edited by Erik Christensen; 7 Jan 2010, 12:02 PM.

                        Comment


                        • #13
                          Erik,

                          Very nice code!

                          Code:
                          St="Math expression evaluator with built-in constants and conversions for PBWin91. Program version 1.5   -   January 6, 2010"+$CRLF+$CRLF+ _
                          I downloaded PB/Win 9.03.0112 today - obviously the newest update.
                          With which version have you tested the program?

                          Rgds.
                          Gert
                          Gert Voland

                          Comment


                          • #14
                            Gert, there should be no problem with any of the PBwin9 versions.

                            Comment


                            • #15
                              Erik,

                              there should be no problem with any of the PBwin9 versions.
                              I am not suggesting any problems ...

                              Just wondered which version you are referring to: PBWin91. Program version 1.5 ?

                              Rgds,
                              Gert
                              Gert Voland

                              Comment


                              • #16
                                Just to inform you that an updated version for PBwin10 is here:

                                http://www.powerbasic.com/support/pb...ad.php?t=53476

                                Best regards,

                                Erik

                                Comment

                                Working...
                                X