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

Math Expression Evaluator updated for PBWin10

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

  • PBWin Math Expression Evaluator updated for PBWin10

    ' Math Expression Evaluator updated for PBWin10.
    '
    ' See previous versions here: http://www.powerbasic.com/support/pb...ad.php?t=24616
    '
    ' Best regards,
    '
    ' Erik

    Code:
    ' Math Expression Evaluator updated for PBWin10.
    '
    ' See previous versions here: http://www.powerbasic.com/support/pbforums/showthread.php?t=24616
    '
    ' Best regards,
    '
    ' Erik
    #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 Begin1      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.
           '
           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"
       Begin1 = Pl
       DO
          ValidVal = 1
          DECR Begin1
          P = INSTR(Valid, MID$(InString, Begin1, 1))
          IF P THEN
             IF ((P = 12) _         ' -
                OR (P = 13)) _      ' +
                AND (Sign = 0) _    ' no sign yet
                AND (Begin1 > 1) _
                THEN
                   IF INSTR("1234567890.", MID$(InString, Begin1 - 1, 1)) THEN ' ~ if not D or E
                      ValidVal = 0: INCR Begin1
                   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 Begin1
             END IF
          ELSE
             ValidVal = 0: INCR Begin1
          END IF
       LOOP WHILE (ValidVal = 1) AND (Begin1 > 1)
       LftWing = LEFT$(InString, Begin1 - 1)                  ' left wing prior to LftWingVal
       LftWingVal = VAL(MID$(InString, Begin1, Pl - Begin1))   ' left wing value
       IF Pl = Begin1 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
       Begin1 = 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 August 31, 2013 -- Erik Christensen"
        LOCAL Style&
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER
        DIALOG NEW PIXELS, 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.6   -   august 31, 2013"+$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 txt1$,Res&
                        txt1$ = 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(txt1$) TO Res&
                                IF Res& = %LB_ERR THEN txt1$ = CHR$(ASC(txt1$)+1) : flag = 1 ' First letter missing - move on to next letter
                            LOOP UNTIL Res&<>%LB_ERR OR txt1$ >= "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.
                                    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA 'ny
                        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&
        '
        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,-1,0  ' deselect all text. Put caret at the end
    
            INCR Number&
            t = t + "Evaluation "+STR$(Number&)+$CRLF
            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
            '
            Test$ = UCASE$(Test$)               ' only upper case letters are used in evaluation the expression
            Test$ = REMOVE$(Test$," ")          ' remove space characters from the expression
    
            ' insert extra parentheses to ensure correct evaluation of logical expressions
            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$, "()")
            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
    
            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 DWORD, lpEnd AS DWORD
        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 DWORD, lpEnd AS DWORD
        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
    ' ------------------------------------------------
    CALLBACK FUNCTION EditFormulaProc
        LOCAL hCtl&,j&,Result&
        SELECT CASE CBMSG
            CASE %WM_INITDIALOG
                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 DWORD, lpEnd AS DWORD
        ' If pressed keyboard character was meant to scroll listbox, then remove it from the expression.
        IF CB.CTLMSG = %EN_UPDATE AND ListFlag = 1 THEN ' the %EN_CHANGE notification does not work satisfactorily with PBwin10
            ' 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
        CF = 2
        LOCAL Style&,Exstyle&,LabelStyle&,DWstyle&,ListStyle&
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
        ExStyle& = 0
        LabelStyle& = %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT
    
        DIALOG NEW PIXELS, 0, "Math expression evaluator with built-in constants and conversions", 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,62,ListStyle& OR %LBS_MULTICOLUMN  ,%WS_EX_CLIENTEDGE CALL CallbackListbox2
        LOCAL cv&: 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, 11*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
    ' ------------------------------------------------
    Attached Files
Working...
X