Announcement

Collapse
No announcement yet.

Is there a PB Calculator?

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

  • Is there a PB Calculator?

    Has anyone ever created a calculator that calculates according to any of the math functions available to we programmers in PB. If so, is a programmable calculator, that is, can it calculate multiple functions in one step. example ABS(SQR(FRAC(x)))
    I had sent in an NFS for a calculator as part of the PB IDEs, but without these specifics.

    I have searched the forums and did not come up with anything, so I thought I'd ask.
    Before anyone suggests a that this is a good project for someone to get their feet wet, which it is, my feet are in so deep I'm drowning in projects.
    Rod
    I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

  • #2
    Have not seen it myself but.....
    - Petzold's book included a calculator app
    - All the Petzold apps were ported to PB by someone
    - Those ported apps were at one time and probably still are available here (files section?)
    Michael Mattias
    Tal Systems Inc. (retired)
    Racine WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      Oops, my bad....

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

      You want an expression evaluator, not a calculator.

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

      MCM
      Michael Mattias
      Tal Systems Inc. (retired)
      Racine WI USA
      [email protected]
      http://www.talsystems.com

      Comment


      • #4
        Well, not just an expression calculator, but a calculator with all the regular features plus the PB functions and capable of handling expressions. Similar to the Windows calculator Scientific format with the PB functions added.
        Rod
        I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

        Comment


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

          Look in the downloads for XP Powertoys...

          It's a single executable, lightweight -
          Scott Turchin
          MCSE, MCP+I
          http://www.tngbbs.com
          ----------------------
          True Karate-do is this: that in daily life, one's mind and body be trained and developed in a spirit of humility; and that in critical times, one be devoted utterly to the cause of justice. -Gichin Funakoshi

          Comment


          • #6
            Although not PB-specific, something like http://www.allersoft.com/allercalc.htm might be useful.
            Erich Schulman (KT4VOL/KTN4CA)
            Go Big Orange

            Comment


            • #7
              Rodney,

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

              Kind regards
              Eddy

              Comment


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

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

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

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

                Thanks for the responses.
                Rod
                I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                Comment


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

                  Comment


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

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

                    Thanks.
                    Rod
                    I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                    Comment


                    • #11
                      http://www.jose.it-berater.org/smffo...sg2815#msg2815
                      thinBasic programming language
                      Win10 64bit - 8GB Ram - i7 M620 2.67GHz - NVIDIA Quadro FX1800M 1GB

                      Comment


                      • #12
                        Thanks Eros.
                        I've downloaded and will peruse it to see if it's what I'm looking for.
                        Rod
                        I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                        Comment


                        • #13
                          Eros posted exactly what I was thinking AWESOME job by the way Eros :top:

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

                          One thing I have not figured out, is how to call a function from a dll via your scripting engine. Although I have another way of doing it, it would greatly improve techniques if I could do it your way.
                          Engineer's Motto: If it aint broke take it apart and fix it

                          "If at 1st you don't succeed... call it version 1.0"

                          "Half of Programming is coding"....."The other 90% is DEBUGGING"

                          "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                          Comment


                          • #14
                            Updated Evaluator

                            Here's a slightly updated version of the Evaluator.

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

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

                            Many Thanks to Gafny and Erik for providing this tool.


                            Code:
                            ' Further improved math expression evaluator for PBWin70.
                            '
                            ' This version of the math parser or interpreter includes more functions
                            ' and error checking.
                            ' Using extended precision, 18 digits of precision is obtained. Factorials
                            ' up to 1754! can be handled without overflow. A number of constants
                            ' and conversions are available, making this math evaluator an advanced
                            ' scientific calculator. You can easily add your own functions, constants
                            ' and conversions to the source code. Input of angles can be in degrees and
                            ' radians. However, trigonometric output using the ARC functions will
                            ' always be in radians. You can transform angles to radians and vice versa
                            ' using the built-in conversions. Input of your math expression can be done
                            ' using the keyboard or by clicking the items in the list boxes.
                            ' Expressions and functions should be entered strictly according to standard
                            ' algebraic syntax rules. Operators and expressions which can be used are:
                            ' + - * / \ ^ ! ( ) < = > <> >= <= in addition to those shown
                            ' in the list box.
                            ' The Operator Precedence follows as closely as possible that used by
                            ' PowerBasic - see the section on "Operator Precedence" in the PowerBasic
                            ' help file. The only exception is the unary negation operator which in this
                            ' program does not have a special priority following exponentiation.
                            ' However, operations inside parentheses always have the highest
                            ' priority and are always evaluated first. Thus by using parentheses in the
                            ' right places you can always obtain the operator precedence you need for
                            ' your purpose.
                            ' The following operator precedence is used in the program:
                            ' 1. parentheses ( )
                            ' 2. unary operators (Factorials (!) )
                            ' 3. one argument functions
                            ' 4. exponentiation (^) (power expressions)
                            ' 5. multiplication (*) and floating-point division (/)
                            ' 6. integer division (\)
                            ' 7. modulo (MOD)
                            ' 8. addition (+), subtraction (-)
                            ' 9. relational operators (<, <=, =, >=, >, <> )
                            ' 10. NOT, ISFALSE and ISTRUE
                            ' 11. AND
                            ' 12. OR and XOR (exclusive OR)
                            ' 13. EQV (equivalence)
                            ' 14. IMP (implication)
                            
                            ' Many thanks to Gafny Jacob, who provided the original code, which have
                            ' been considerably changed and improved. Thanks to Achilles B. Mina
                            ' for free to use code concerning conversions and constants. Thanks
                            ' to Tony Burcham and Gunar Zagars for valuable contributions
                            ' concerning error checking and overflow indication. Also many thanks to
                            ' the whole PowerBasic forum for great inspiration.
                            '
                            ' Good luck! -- August 17, 2003 -- Erik Christensen -- [email protected]
                            ' NB: Important improvement made June 10 and June 29, 2005
                            
                            
                            
                            #COMPILE EXE
                            #REGISTER NONE
                            #DIM ALL
                            '
                            %FORM1_CLEAREXPRESSION  = 90
                            %FORM1_BUTTONDOANALYSIS = 100
                            %FORM1_BUTTONHELP       = 103
                            %FORM1_BUTTONABOUT      = 106
                            %FORM1_BUTTONEXIT       = 110
                            %FORM1_TEXTRESULTS      = 120
                            %FORM1_TEXTFORMULA      = 130
                            %FORM1_LABEL            = 140
                            %FORM1_LABEL2           = 150
                            %FORM1_LABEL3           = 155
                            %FORM1_LABEL4           = 157
                            %FORM1_DESCRIBE         = 160
                            %FORM1_LISTBOX1         = 170
                            %FORM1_LISTBOX2         = 172
                            %LabelRadioButtonAction = 175
                            %RadioButtonRadians     = 180
                            %RadioButtonDegrees     = 185
                            %HelpText               = 190
                            %HelpExitButton         = 195
                            '
                            #INCLUDE "WIN32API.INC"
                            #INCLUDE "COMMCTRL.INC"
                            '
                            GLOBAL gOldSubClassEdit&
                            GLOBAL hForm1&, hHelpForm&,hList2&,hTxt1&   ' handles
                            GLOBAL ListFlag AS LONG
                            GLOBAL Trig() AS STRING
                            GLOBAL CheckArr() AS STRING
                            GLOBAL FirstTime  AS LONG
                            GLOBAL ErrorTxt AS STRING
                            GLOBAL ErrorMes AS STRING
                            GLOBAL Extra() AS STRING, NoEx AS LONG
                            GLOBAL CF AS SINGLE
                            '
                            FUNCTION FindMatch(InString AS STRING) AS LONG
                               LOCAL Cntr AS LONG
                               LOCAL Pl   AS LONG
                               DO WHILE pl <= LEN(InString)
                                  INCR Pl
                                  IF (MID$(InString, Pl, 1) = ")") THEN DECR Cntr
                                  IF (MID$(InString, Pl, 1) = "(") THEN INCR Cntr
                                  IF (MID$(InString, Pl, 1) = ")") AND ISFALSE Cntr THEN
                                     FUNCTION = pl
                                     EXIT DO
                                  END IF
                               LOOP
                            END FUNCTION
                            '
                            
                            FUNCTION Factorial(InVal AS LONG) AS EXT
                               LOCAL i  AS LONG
                               LOCAL r  AS EXT
                               r = 1
                               FOR i = 2 TO InVal
                                  r = r * i
                               NEXT
                               FUNCTION = r
                            END FUNCTION
                            '
                            FUNCTION Eval(Formula AS STRING) AS EXT
                               LOCAL InString   AS STRING
                               LOCAL checkStr   AS STRING
                               LOCAL EndPl      AS LONG
                               LOCAL Tmp        AS STRING
                               LOCAL Expr       AS STRING
                               LOCAL SaveExpr   AS STRING
                               LOCAL ExprVal    AS EXT
                               LOCAL Owner      AS STRING
                               LOCAL LastDigit  AS LONG
                               LOCAL LastDigOld AS LONG
                               LOCAL Ex         AS LONG
                               LOCAL Dp         AS LONG
                               LOCAL RitWingLen AS LONG
                               LOCAL InStrLen   AS LONG
                               LOCAL p          AS LONG
                               LOCAL Plc        AS LONG
                               LOCAL pp         AS LONG
                               LOCAL Mp         AS LONG
                               LOCAL Mm         AS LONG
                               LOCAL PExp       AS LONG
                               LOCAL MExp       AS LONG
                               LOCAL Padd       AS LONG
                               LOCAL Psub       AS LONG
                               LOCAL BEGIN      AS LONG
                               LOCAL Sign       AS LONG
                               LOCAL pMod       AS LONG
                               LOCAL RemoveFlag AS LONG
                               LOCAL ValidVal   AS LONG
                            
                               LOCAL LftWing    AS STRING
                               LOCAL RitWing    AS STRING
                               LOCAL RitWingval AS EXT
                               LOCAL X          AS EXT
                               LOCAL LftWingval AS EXT
                               LOCAL Pl         AS LONG
                               LOCAL Valid      AS STRING
                               LOCAL digit      AS STRING
                               LOCAL i          AS LONG
                               LOCAL Result     AS EXT
                               LOCAL Numeral    AS STRING
                               LOCAL TicTac     AS LONG
                               LOCAL l          AS LONG
                               LOCAL De         AS STRING
                               LOCAL Block      AS STRING
                               LOCAL Mult       AS LONG
                               LOCAL Div        AS LONG
                               LOCAL IDiv       AS LONG
                               LOCAL P1         AS LONG
                               LOCAL P2         AS LONG
                               LOCAL P3         AS LONG
                               LOCAL P4         AS LONG
                               LOCAL P5         AS LONG
                               LOCAL P6         AS LONG
                               '
                               Instring = Formula
                               '
                               IF ISTRUE FirstTime THEN ' Check and "re-shape" expression string to facilitate evaluation.
                                   '
                                 '  Instring = UCASE$(Formula)
                                 '  Instring = REMOVE$(Instring," ")
                                   IF Instring = "" THEN ErrorMes = "Empty expression! - You need to enter an expression." : GOTO ExitOnError
                                   '
                                   ' 1. Check for unknown words in CheckStr (copy of InString)
                                   CheckStr = InString
                                   ' remove known words
                                   LOCAL ccc&, ttt$
                                   FOR i = 1 TO UBOUND(CheckArr)
                                       ttt$ = CheckArr(i)
                                       ccc& = INSTR(ttt$,"()")
                                       IF ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1) : GOTO hop2
                                       ccc& = INSTR(ttt$," ")
                                       IF ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
                                      hop2:
                                       CheckStr = REMOVE$(CheckStr,ttt$)
                                   NEXT
                                   LOCAL k1&,k2&
                                   ' locate unknown words or characters
                                   FOR i = 1 TO LEN(CheckStr)
                                       IF INSTR("0123456789ED.-+*/\^!()=<>", MID$(CheckStr,i,1)) = 0 THEN
                                           IF k1&=0 THEN k1& = i : k2& = i
                                           IF k1&>0 THEN k2& = i
                                       END IF
                                   NEXT
                                   IF k1&>0 THEN ErrorMes = "Cannot understand this: " + MID$(CheckStr,k1&,k2&-k1&+1) + " Please correct. "  : GOTO ExitOnError
                                   '
                                   ' 2. Check syntax.
                                   ' This part is heavily inspired by a fine code by Tony Burcham. Thank you.
                                   CheckStr = InString
                                   REPLACE "PI#" WITH "1.1" IN CheckStr  ' Temporary replacememt
                                   REPLACE "E#" WITH  "11"  IN CheckStr  ' Temporary replacememt
                                   ' Replace function name letters with F and logical functions with L
                                   FOR i = 1 TO UBOUND(CheckArr)
                                       ttt$ = CheckArr(i)
                                       ccc& = INSTR(ttt$,"()")
                                       IF ISTRUE ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
                                       IF INSTR(CheckStr,ttt$) THEN REPLACE ttt$ WITH STRING$(LEN(ttt$),"F") IN CheckStr
                                   NEXT
                                   FOR i = 1 TO UBOUND(CheckArr)
                                       ttt$ = CheckArr(i)
                                       ccc& = INSTR(ttt$," ")
                                       IF ISTRUE ccc& THEN ttt$ = LEFT$(ttt$,ccc&-1)
                                       IF INSTR(CheckStr,ttt$) THEN REPLACE ttt$ WITH STRING$(LEN(ttt$),"L") IN CheckStr
                                   NEXT
                                   ' Make map string and detect any bad characters
                                   REPLACE ANY "0123456789ED-/\^" WITH "##########EE+***" IN CheckStr
                                   LOCAL posi&,Er&
                                   i = VERIFY(CheckStr,"#.+*EFL()<>=!")
                                   IF i THEN ErrorMes = "Illegal character: " + MID$(Instring,i,1) + "  Please correct. "  : GOTO ExitOnError
                                   ' Scan for illegal sequences
                                   LOCAL bad AS STRING, pc&
                                   'bad = " () (* )F )E )# +) +* +E *) ** *E F) F+ F* F. F# FE .( .. .F .E #( #F E( E) E* EF E. EE !# F! L) L+ L* L. LE .L EL L!"
                                   bad = "()(*)F)E)#+)+*+E*)***EF)F+F*F.F#FE.(...F.E#(#FE(E)E*EFE.EE!#F!L)L+L*L.LE.LELL!" 'compressed version of above
                                   FOR i = 1 TO LEN(bad) STEP 2
                                       pc = INSTR(CheckStr, MID$(bad,i,2))
                                       IF pc THEN ErrorMes = "Illegal character sequence: " + MID$(Instring,pc,2) + "  Please correct. "  : GOTO ExitOnError
                                   NEXT
                                   ' check end of string
                                   IF INSTR("+*FEL", RIGHT$(CheckStr, 1 )) THEN ErrorMes = "Illegal last character: " + RIGHT$(Instring,1) + "  Please correct. "  : GOTO ExitOnError
                                   ' since "*+" and "++" are allowed, we have
                                   ' to check for operator triplets
                                   REPLACE "*" WITH "+" IN CheckStr
                                   pc = INSTR(CheckStr, "+++")
                                   IF pc THEN ErrorMes = "Illegal character sequence: " + MID$(Instring,pc,3) + "  Please correct. "  : GOTO ExitOnError
                                   '
                                   ' checking OK, so continue to prepare expression for parsing
                                   REPLACE "PI#" WITH "3.14159265358979324" IN Instring
                                   REPLACE "E#" WITH "2.71828182845904524" IN Instring
                                   '
                                   REPLACE "LN" WITH "LOG" IN Instring  ' LOG is used for LN in the parsing
                                   '
                                   REPLACE "LOG10" WITH "CLG" IN Instring ' to avoid confusing numbers
                                   REPLACE "LOG2" WITH "TLG" IN Instring ' to avoid confusing numbers
                                   REPLACE "EXP10" WITH "ETE" IN Instring ' to avoid confusing numbers
                                   REPLACE "EXP2" WITH "ETO" IN Instring ' to avoid confusing numbers
                                   REPLACE "MOD" WITH CHR$(254) IN InString
                                   '
                                   'if
                                   '
                                   REPLACE "XOR" WITH CHR$(222) IN Instring ' to avoid confusion with OR
                                   REPLACE "OR" WITH CHR$(223) IN Instring ' to avoid confusion with XOR
                                   REPLACE "NOT" WITH CHR$(247) IN Instring
                                   REPLACE "ISTRUE" WITH CHR$(215) IN Instring
                                   REPLACE "ISFALSE" WITH CHR$(182) IN Instring
                                   '
                                   REPLACE "<>" WITH CHR$(174) IN Instring  ' one-character code for <>
                                   REPLACE "><" WITH CHR$(174) IN Instring
                                   REPLACE ">=" WITH CHR$(169) IN Instring  ' one-character code for >=
                                   REPLACE "=>" WITH CHR$(169) IN Instring
                                   REPLACE "<=" WITH CHR$(167) IN Instring  ' one-character code for <=
                                   REPLACE "=<" WITH CHR$(167) IN Instring
                            
                                   '
                                   FirstTime = %FALSE
                               END IF
                               '
                               ' Check parentheses
                               IF TALLY(InString, "(") <> TALLY(InString, ")") THEN ErrorMes = "Parentheses mismatch" : GOTO ExitOnError
                               '
                               ' Priority 1.
                               ' Evaluate parentheses ( )
                               ' Evaluate each parenthesis in turn.
                               DO
                                  Plc = INSTR(1 + Plc, InString, "(") ' find left parenthesis
                                  IF Plc THEN
                                    EndPl = FindMatch(MID$(InString, Plc)) ' find matching right parenthesis
                                    IF EndPl = 2 THEN ErrorMes = "Empty parenthesis" : GOTO ExitOnError
                                    SaveExpr = MID$(InString, Plc + 1, EndPl - 2) ' Expression in between
                                    Owner = LTRIM$(STR$(VAL(SaveExpr),18))
                                    IF (SaveExpr = Owner) OR (SaveExpr = "+" & Owner) OR (SaveExpr = Owner + "!" ) THEN ' this part fully evaluated or just needs calculation of factorial
                                        IF RIGHT$(SaveExpr,1) = "!" THEN Owner = Owner +"!" ' Keep any ! sign for proper evaluation of Factorial
                                        InString = LEFT$(InString, Plc - 1) & Owner & MID$(InString, Plc + EndPl)
                                    ELSE                                                   ' this part not fully evaluated
                                        ExprVal = Eval(SaveExpr)                           ' evaluate expression - recursive call
                                        ' insert evaluated part in proper place
                                        InString = LEFT$(InString, Plc - 1) & LTRIM$(STR$(ExprVal,18)) & MID$(InString, Plc + EndPl)
                                    END IF
                                  ELSE
                                    EXIT DO
                                  END IF
                               LOOP
                               '
                               ' Remove multiple signs which may occur after evaluation of parentheses.
                               REPLACE "++" WITH "+" IN Instring
                               REPLACE "-+" WITH "-" IN Instring
                               REPLACE "+-" WITH "-" IN Instring
                               REPLACE "--" WITH "+" IN Instring
                               '
                               Tmp = LTRIM$(STR$(VAL(InString),18))
                               '
                               ' Finished or not ?
                               IF (Tmp = InString) OR ("+" & Tmp = InsTring) GOTO ExitOk
                                '
                                ' Priority 2.
                                ' Evaluate UNARY operators
                                '
                                ' calculate factorials
                                DO
                                   Pl = INSTR(InString, "!")
                                   IF Pl THEN
                                      RitWing = MID$(InString, Pl + 1)
                                      GOSUB GetLeftWing
                                      IF LftWingVal <> FIX(LftWingVal) THEN ErrorMes = "Invalid factorial argument: Non integer." : GOTO ExitOnError
                                      IF ABS(LftWingVal) > 1754 THEN ErrorMes = "Factorial argument too large." : GOTO ExitOnError
                                      LOCAL flg3& : flg3 = 1
                                      IF LftWingVal < 0 THEN LftWingVal = ABS(LftWingVal) : flg3 = -1
                                      LOCAL FAC## : FAC## = Factorial##(CLNG(LftWingVal)) * flg3
                                      InString = LftWing & LTRIM$(STR$(FAC##,18)) & RitWing
                                      LftWing = "": RitWing = ""
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                               '
                               ' Priority 3:
                               ' Calculate built-in and some extra one argument functions:
                               '
                               ' Angles measured in degrees ?
                               LOCAL res&
                               CONTROL SEND hForm1&,%RadioButtonDegrees,%BM_GETCHECK,0,0 TO res&
                               '
                               FOR i = 1 TO UBOUND(Trig)
                                  DO
                                    Pl = INSTR(InString, Trig(i))
                                    IF Pl THEN
                                      LftWing = LEFT$(InString, Pl - 1) ' string prior to function
                                      Pl = Pl + LEN(Trig(i)) - 1 ' place at start of argument
                                      '
                                      GOSUB GetRightWing : X = RitWingVal ' Get argument
                                      '
                                      ' If Angles measured in degrees - then transform to radians (only for non-inverse trig functions).
                                      ' Inverse trig-(ARC)functions will always be returned in radians.
                                      IF res&=%BST_CHECKED AND i<= 22 AND i>=12 THEN X = X * 1.74532925199432958E-2
                                      '
                                      SELECT CASE i
                                        CASE 1: Result = LOG(X + SQR(X * X + 1))                                      ' ARCSINH
                                        CASE 2: IF X < 1 THEN ErrorMes = "Argument outside range for ARCCOSH" :GOTO ExitOnError
                                                IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCOSH. Will give overflow" :GOTO ExitOnError
                                                Result = LOG(X + SQR(X * X - 1))                                      ' ARCCOSH
                                        CASE 3: IF ABS(X)>=1 THEN ErrorMes = "Argument outside range for ARCTANH" :GOTO ExitOnError
                                                Result = LOG((1 + X) / (1 - X)) / 2                                   ' ARCTANH
                                        CASE 4: IF (X<=0 OR X>1) THEN ErrorMes = "Argument outside range for ARCSECH" :GOTO ExitOnError
                                                Result = LOG((SQR(-X * X + 1) + 1) / X)                               ' ARCSECH
                                        CASE 5: IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCSCH. Will give overflow" :GOTO ExitOnError
                                                Result = LOG((SGN(X) * SQR(X * X + 1) + 1) / X)                       ' ARCCSCH
                                        CASE 6: IF ABS(X)<=1 THEN ErrorMes = "Argument outside range for ARCCOTH" :GOTO ExitOnError
                                                Result = LOG((X + 1) / (X - 1)) / 2                                   ' ARCCOTH
                                        CASE 7: IF ABS(X)>1 THEN ErrorMes = "Argument outside range for ARCSIN" :GOTO ExitOnError
                                                Result = ATN(X / SQR(-X * X + 1))                                     ' ARCSIN
                                        CASE 8: IF ABS(X)>1 THEN ErrorMes = "Argument outside range for ARCCOS" :GOTO ExitOnError
                                                Result = -ATN(X / SQR(-X * X + 1)) + 1.57079632679489662              ' ARCCOS
                                        CASE 9: IF ABS(X)<1 THEN ErrorMes = "Argument outside range for ARCSEC" :GOTO ExitOnError
                                                IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCSEC. Will give overflow" :GOTO ExitOnError
                                                Result = ATN(X / SQR(X * X - 1)) + SGN(X - 1) * 1.57079632679489662   ' ARCSEC
                                        CASE 10:IF ABS(X)<1 THEN ErrorMes = "Argument outside range for ARCCSC" :GOTO ExitOnError
                                                IF LOG(X)>5678 THEN ErrorMes = "Argument too large for ARCCSC. Will give overflow" :GOTO ExitOnError
                                                Result = ATN(X / SQR(X * X - 1)) + (SGN(X) - 1) * 1.57079632679489662 ' ARCCSC
                                        CASE 11:Result = ATN(X) + 1.57079632679489662                                 ' ARCCOT
                                        CASE 12:IF ABS(X)>11356 THEN ErrorMes = "Argument too large for SINH. Will give overflow. " :GOTO ExitOnError
                                                Result = (EXP(X) - EXP(-X)) / 2                  ' SINH
                                        CASE 13:IF ABS(X)>11356 THEN Result = SGN(X) : EXIT SELECT
                                                Result = (EXP(X) - EXP(-X)) / (EXP(X) + EXP(-X)) ' TANH
                                        CASE 14:IF ABS(X)>11356 THEN Result = 0 : EXIT SELECT
                                                Result = 2 / (EXP(X) + EXP(-X))                  ' SECH
                                        CASE 15:IF X=0 THEN ErrorMes = "Argument for CSCH is zero." :GOTO ExitOnError
                                                Result = 2 / (EXP(X) - EXP(-X))                  ' CSCH
                                        CASE 16:IF X=0 THEN ErrorMes = "Argument for COTH is zero." :GOTO ExitOnError
                                                IF ABS(X)>11356 THEN Result = SGN(X) : EXIT SELECT
                                                Result = (EXP(X) + EXP(-X)) / (EXP(X) - EXP(-X)) ' COTH
                                        CASE 17:IF COS(X)=0 THEN ErrorMes = "SEC is not defined for this argument." :GOTO ExitOnError
                                                Result = 1 / COS(X)                              ' SEC
                                        CASE 18:IF SIN(X)=0 THEN ErrorMes = "CSC is not defined for this argument." :GOTO ExitOnError
                                                Result = 1 / SIN(X)                              ' CSC
                                        CASE 19:IF TAN(X)=0 THEN ErrorMes = "COT is not defined for this argument." :GOTO ExitOnError
                                                Result = 1 / TAN(X)                              ' COT
                                        CASE 20:Result = SIN(X)
                                        CASE 21:Result = COS(X)
                                        CASE 22:Result = TAN(X)
                                        CASE 23:Result = ATN(X)
                                        CASE 24:IF X <= 0 THEN ErrorMes = "LN or LOG <= 0" : GOTO ExitOnError
                                                Result = LOG(X)
                                        CASE 25:IF ABS(X)>11356 THEN ErrorMes = "Argument too large for EXP. Will give overflow. " :GOTO ExitOnError
                                            Result = EXP(X)
                                        CASE 26:IF X < 0 THEN ErrorMes = "Square Root < 0" :GOTO ExitOnError
                                                Result = SQR(X)
                                        CASE 27:IF X <= 0 THEN ErrorMes = "LOG10 <= 0" :GOTO ExitOnError
                                                Result = LOG10(X)
                                        CASE 28:Result = ABS(X)
                                        CASE 29:IF X <= 0 THEN ErrorMes = "LOG2 <= 0" :GOTO ExitOnError
                                                Result = LOG2(X)
                                        CASE 30:Result = CEIL(X)
                                        CASE 31:Result = FIX(X)
                                        CASE 32:Result = FRAC(X)
                                        CASE 33:Result = SGN(X)
                                        CASE 34:IF ABS(X)>16383 THEN ErrorMes = "Argument too large for EXP2. Will give overflow. " :GOTO ExitOnError
                                                Result = EXP2(X)
                                        CASE 35:IF ABS(X)>4932 THEN ErrorMes = "Argument too large for EXP10. Will give overflow. " :GOTO ExitOnError
                                                Result = EXP10(X)
                                      END SELECT
                                      ' Update InString with result and reset helper variables.
                                      InString = LftWing + LTRIM$(STR$(Result,18)) + RitWing
                                      GOSUB CleanUpVar
                                    ELSE
                                      EXIT DO
                                    END IF
                                  LOOP
                                NEXT
                                '
                                ' Priority 4:
                                ' calculate exponentiation (^) (power expressions)
                                DO
                                   Pl = INSTR(InString, "^")
                                   IF Pl = 1 THEN
                                       ErrorMes = "Missing left argument in power espression" : GOTO ExitOnError
                                   ELSEIF Pl > 1 THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      IF LftWingVal>1 AND ABS(RitWingVal*LOG(LftWingVal))>11356 THEN ErrorMes = "Arguments too large for exponentiation. Will give overflow." :GOTO ExitOnError
                                      IF LftWingVal<0 AND FRAC(RitWingVal)<>0 THEN ErrorMes = "Exponentiation problem: Negative root is not allowed with a non-integer exponent." :GOTO ExitOnError
                                      Block = LTRIM$(STR$(LftWingVal ^ RitWingVal,18))
                                      InString = LftWing & Block & RitWing
                                      IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk ' fully evaluated
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 5:
                                ' Perform multiplication (*) and floating-point division (/)
                                DO
                                   InStrLen = LEN(InString)
                                   Mult = INSTR(InString, "*") : IF ISFALSE Mult THEN Mult = InStrLen
                                   Div =  INSTR(InString, "/") : IF ISFALSE Div THEN Div = InStrLen
                                   Pl = MIN(Mult, Div)
                                   IF Pl = InstrLen THEN Pl = 0
                                   IF Pl = 1 THEN
                                       ErrorMes = "Missing left argument in multiplication (*) or floating-point division (/)" : GOTO ExitOnError
                                   ELSEIF Pl > 1 THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      IF Pl = Mult THEN
                                         IF LOG(ABS(LftWingVal)) + LOG(ABS(RitWingVal)) > 11356 THEN ErrorMes = "Arguments too large for multiplication. Will give overflow" :GOTO ExitOnError
                                         result = LftWingVal * RitWingVal
                                      ELSEIF Pl = Div THEN
                                         IF RitWingVal = 0 THEN ErrorMes = "Division by zero" : GOTO ExitOnError
                                         result = LftWingVal / RitWingVal
                                      END IF
                                      Block = LTRIM$(STR$(result,18))
                                      InString = LftWing & Block  & RitWing
                                      IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 6:
                                ' Perform integer division (\)
                                DO
                                   InStrLen = LEN(InString)
                                   Pl = INSTR(InString, "\")
                                   IF Pl = InstrLen THEN Pl = 0
                                   IF Pl = 1 THEN
                                       ErrorMes = "Missing left argument in integer division (\)" : GOTO ExitOnError
                                   ELSEIF Pl > 1 THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      IF RitWingVal = 0 THEN ErrorMes = "Integer Division by zero" : GOTO ExitOnError
                                      result = LftWingVal \ RitWingVal
                                      Block = LTRIM$(STR$(result,18))
                                      InString = LftWing & Block  & RitWing
                                      IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 7:
                                ' Perform modulo (MOD) operation
                                DO
                                   InStrLen = LEN(InString)
                                   Pl = INSTR(InString, CHR$(254))
                                   IF Pl = InstrLen THEN Pl = 0
                                   IF Pl = 1 THEN
                                       ErrorMes = "Missing left argument in MOD expression" : GOTO ExitOnError
                                   ELSEIF Pl > 1 THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      IF RitWingVal = 0 THEN ErrorMes = "Division by zero in MOD expression" : GOTO ExitOnError
                                      result = LftWingVal MOD RitWingVal
                                      Block = LTRIM$(STR$(result,18))
                                      InString = LftWing & Block  & RitWing
                                      IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 8:
                                ' Perform addition (+) and subtraction (-)
                                '
                                DO
                                   PExp = 2: MExp = 1: InstrLen = LEN(InString)
                            PlusFind:
                                   PAdd = INSTR(PExp, InString, "+")
                                   IF Padd THEN
                                      De = MID$(InString, PAdd - 1, 1)
                                      IF (De = "D") OR (De = "E") THEN
                                         PExp = Padd + 1
                                         GOTO PlusFind
                                      END IF
                                   ELSE
                                      PAdd = InstrLen
                                   END IF
                            '
                            MinusFind:
                                   INCR TicTac
                                   IF TicTac = InstrLen + 1 GOTO RelationalOp
                                   PSub = INSTR(MExp, InString, "-")
                                   IF Psub = 1 THEN
                                      IF LEN(STR$(VAL(InString),18)) = InstrLen GOTO ExitOk
                                      MExp = 2
                                      GOTO MinusFind
                                   END IF
                                   IF PSub THEN
                                      De = MID$(InString, PSub - 1, 1)
                                      IF De < "0" OR De > "9" THEN
                                         MExp = PSub + 1
                                         GOTO MinusFind
                                      END IF
                                   ELSE
                                      Psub = InstrLen
                                   END IF
                                   Pl = MIN(PAdd, PSub)
                                   IF Pl = InstrLen THEN Pl = 0
                                   IF Pl THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      IF Pl = PAdd THEN
                                         Result = LftWingVal + RitWingVal
                                      ELSEIF Pl = PSub THEN
                                         result = LftWingVal - RitWingVal
                                      END IF
                                      TicTac = 0
                                      Block = LTRIM$(STR$(Result,18))
                                      InString = LftWing & Block & RitWing
                                      IF Block = InString OR InString = "-1=-1" THEN GOSUB CleanUpVar : GOTO ExitOk
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 9:
                                ' Evaluate relational operators (<, <=, =, >=, >, <> )
                                '
                            RelationalOp:
                                DO
                                   InStrLen = LEN(InString)
                                   P1 = INSTR(InString, "=") : IF P1 = 0 THEN P1 = InStrLen
                                   P2 = INSTR(InString, ">") : IF P2 = 0 THEN P2 = InStrLen
                                   P3 = INSTR(InString, "<") : IF P3 = 0 THEN P3 = InStrLen
                                   '
                                   P4 = INSTR(InString, CHR$(174)) : IF P4 = 0 THEN P4 = InStrLen ' <>
                                   P5 = INSTR(InString, CHR$(169)) : IF P5 = 0 THEN P5 = InStrLen ' >=
                                   P6 = INSTR(InString, CHR$(167)) : IF P6 = 0 THEN P6 = InStrLen ' <=
                                   '
                                   Pl = MIN(P1, P2, P3, P4, P5, P6)
                                   IF Pl = InStrLen THEN EXIT DO
                                   IF Pl = 1 THEN
                                       ErrorMes = "No left argument in relational expression" : GOTO ExitOnError
                                   ELSEIF Pl > 1 THEN
                                      GOSUB GetLeftWing : GOSUB GetRightWing
                                      SELECT CASE Pl
                                         CASE P1 : Result = LftWingVal = RitWingVal
                                         CASE P2 : Result = LftWingVal > RitWingVal
                                         CASE P3 : Result = LftWingVal < RitWingVal
                                         CASE P4 : Result = LftWingVal <> RitWingVal
                                         CASE P5 : Result = LftWingVal >= RitWingVal
                                         CASE P6 : Result = LftWingVal <= RitWingVal
                                      END SELECT
                                      Block = LTRIM$(STR$(Result,18))
                                      InString = LftWing & Block & RitWing
                                      IF Block = InString THEN GOSUB CleanUpVar : GOTO ExitOk
                                   ELSE
                                      EXIT DO
                                   END IF
                                LOOP
                                '
                                ' Priority 10:
                                ' Evaluate NOT, ISFALSE and ISTRUE
                                LOCAL Pnot&,Pisfalse&,Pistrue&
                                DO
                                  InStrLen = LEN(InString)
                                  Pnot =  INSTR(InString, CHR$(247)) : IF Pnot =  0 THEN Pnot =  InStrLen
                                  Pisfalse = INSTR(InString, CHR$(182)) : IF Pisfalse = 0 THEN Pisfalse = InStrLen
                                  Pistrue = INSTR(InString, CHR$(215)) : IF Pistrue = 0 THEN Pistrue = InStrLen
                                  Pl = MIN(Pnot, Pisfalse, Pistrue)
                                  IF Pl = InStrLen THEN EXIT DO
                                  IF Pl THEN
                                     GOSUB GetRightWing
                                     IF Pl = Pnot THEN
                                        result = NOT RitWingVal
                                     ELSEIF Pl = Pisfalse THEN
                                        result = ISFALSE RitWingVal
                                     ELSEIF Pl = Pistrue THEN
                                        result = ISTRUE RitWingVal
                                     END IF
                                     InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
                                     LftWing = "": Numeral = "": RitWing = ""
                                  ELSE
                                     EXIT DO
                                  END IF
                                LOOP
                            
                                ' Priority 11:
                                ' Evaluate AND
                                DO
                                  Pl = INSTR(InString, "AND")
                                  IF Pl = 1 THEN
                                      ErrorMes = "No left argument in AND expression" : GOTO ExitOnError
                                  ELSEIF Pl > 1 THEN
                                     GOSUB GetLeftWing
                                     Pl = Pl + 2
                                     GOSUB GetRightWing
                                     Result = LftWingVal AND RitWingVal
                                     InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
                                     LftWing = "": Numeral = "": RitWing = ""
                                  ELSE
                                     EXIT DO
                                  END IF
                                LOOP
                            '   '
                                ' Priority 12:
                                ' Evaluate OR and XOR (exclusive OR)
                                LOCAL Por&,Pxor&
                                DO
                                  InStrLen = LEN(InString)
                                  Por =  INSTR(InString, CHR$(223)) : IF Por =  0 THEN Por =  InStrLen
                                  Pxor = INSTR(InString, CHR$(222)) : IF Pxor = 0 THEN Pxor = InStrLen
                                  Pl = MIN(Por, Pxor)
                                  IF Pl = InStrLen THEN EXIT DO
                                  IF Pl = 1 THEN
                                      ErrorMes = "No left argument in OR or XOR expression" : GOTO ExitOnError
                                  ELSEIF Pl > 1 THEN
                                     GOSUB GetLeftWing : GOSUB GetRightWing
                                     IF Pl = Por THEN
                                        result = LftWingVal OR RitWingVal
                                     ELSEIF Pl = Pxor THEN
                                        result = LftWingVal XOR RitWingVal
                                     END IF
                                     InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
                                     LftWing = "": Numeral = "": RitWing = ""
                                  ELSE
                                     EXIT DO
                                  END IF
                                LOOP
                                '
                                ' Priority 13:
                                ' Evaluate EQV (equivalence)
                                DO
                                  Pl = INSTR(InString, "EQV")
                                  IF Pl = 1 THEN
                                      ErrorMes = "No left argument in EQV expression" : GOTO ExitOnError
                                  ELSEIF Pl > 1 THEN
                                     GOSUB GetLeftWing
                                     Pl = Pl + 2
                                     GOSUB GetRightWing
                                     Result = LftWingVal EQV RitWingVal
                                     InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
                                     LftWing = "": Numeral = "": RitWing = ""
                                  ELSE
                                     EXIT DO
                                  END IF
                                LOOP
                                '
                                ' Priority 14:
                                ' Evaluate IMP (implication)
                                DO
                                  Pl = INSTR(InString, "IMP")
                                  IF Pl = 1 THEN
                                      ErrorMes = "No left argument in IMP expression" : GOTO ExitOnError
                                  ELSEIF Pl > 1 THEN
                                     GOSUB GetLeftWing
                                     Pl = Pl + 2
                                     GOSUB GetRightWing
                                     Result = LftWingVal IMP RitWingVal
                                     InString = LftWing & LTRIM$(STR$(Result,18)) & RitWing
                                     LftWing = "": Numeral = "": RitWing = ""
                                  ELSE
                                     EXIT DO
                                  END IF
                                LOOP
                            '
                            '
                            ExitOk:
                               FUNCTION = VAL(InString)
                               ErrorTxt = ""
                               EXIT FUNCTION
                            '
                            ExitOnError:
                               ErrorTxt = "   Error in Expression: " + ErrorMes
                               FUNCTION = 0
                               EXIT FUNCTION
                            '
                            '
                            GetLeftWing:
                               ' Get left wing and left argument
                               Valid = "1234567890.-+DE"
                               BEGIN = Pl
                               DO
                                  ValidVal = 1
                                  DECR BEGIN
                                  P = INSTR(Valid, MID$(InString, BEGIN, 1))
                                  IF P THEN
                                     IF ((P = 12) _         ' -
                                        OR (P = 13)) _      ' +
                                        AND (Sign = 0) _    ' no sign yet
                                        AND (BEGIN > 1) _
                                        THEN
                                           IF INSTR("1234567890.", MID$(InString, BEGIN - 1, 1)) THEN ' ~ if not D or E
                                              ValidVal = 0: INCR BEGIN
                                           END IF
                                           Sign = -1        ' Sign flag true
                                     ELSEIF (P = 14) _      ' D
                                        OR (P = 15) _       ' E
                                        THEN
                                            Sign = 0: Valid = "1234567890.-+"  ' D and E no more valid
                                     ELSEIF P > 11 THEN
                                        ValidVal = 0
                                        IF Sign THEN INCR BEGIN
                                     END IF
                                  ELSE
                                     ValidVal = 0: INCR BEGIN
                                  END IF
                               LOOP WHILE (ValidVal = 1) AND (BEGIN > 1)
                               LftWing = LEFT$(InString, BEGIN - 1)                  ' left wing prior to LftWingVal
                               LftWingVal = VAL(MID$(InString, BEGIN, Pl - BEGIN))   ' left wing value
                               IF Pl = BEGIN THEN ErrorMes = "Invalid left argument" : GOTO ExitOnError
                               RETURN
                            '
                            '
                            GetRightWing:
                               ' Get right wing and right argument
                               RitWing = MID$(InString, Pl + 1)  ' right wing
                               IF LEN(RitWing) <= 0 THEN ErrorMes = "No right argument" : GOTO ExitOnError
                               RitWingVal = VAL(RitWing) ' Value of (first part of) right wing
                               IF RitWing = LTRIM$(STR$(RitWingVal,18)) THEN ' fully evaluated
                                  RitWing = ""
                                  GOTO FinishRightBlock
                               END IF
                               LastDigit = 1: LastDigOld = 0: EX = 0: DP = 0
                               RitWingLen = LEN(RitWing)
                               DO WHILE LastDigit <= RitWingLen
                                   Digit = MID$(RitWing, LastDigit, 1)
                                   IF LastDigit = 1 THEN ' sign position
                                      IF INSTR("+-", Digit) THEN
                                        IF (SGN(RitWingVal) = 1) AND (Digit = "+") THEN
                                           INCR LastDigit
                                        ELSEIF (SGN(RitWingVal) = -1) AND (Digit = "-") THEN
                                           INCR LastDigit
                                        ELSE
                                           EXIT DO
                                        END IF
                                      END IF
                                   END IF
                                   ' Get valid number
                                   IF INSTR("1234567890", Digit) THEN
                                      INCR LastDigit
                                   ELSEIF Digit = "." THEN
                                      IF Dp = 0 THEN INCR LastDigit: Dp = 1
                                   ELSEIF INSTR("DE", Digit) THEN
                                      IF Ex = 0 THEN INCR LastDigit: Ex = 1
                                   ELSEIF (INSTR("+-", Digit) <> 0) AND (INSTR("DE", MID$(RitWing, MAX(1, LastDigit - 1), 1)) <> 0) THEN
                                      INCR LastDigit
                                   END IF
                                   IF LastDigit = LastDigOld THEN EXIT DO
                                   LastDigOld = LastDigit
                               LOOP
                               RitWing = MID$(RitWing, LastDigit)
                            '
                            FinishRightBlock:
                               P = 0
                               BEGIN = P
                               Sign = P
                               LastDigit = P
                               LastDigOld = P
                               RitWingLen = P
                               Ex = P
                               Dp = P
                               Valid = ""
                               Digit = ""
                               RETURN
                            '
                            CleanUpVar:
                               LftWing = "": Numeral$ = "": RitWing = ""
                               RitWingVal = 0: Result = 0 : X = 0
                               LftWingVal = 0
                               Block = ""  : De = ""
                               RETURN
                            
                            END FUNCTION ' Eval
                            '
                            CALLBACK FUNCTION CBF_HelpExit
                                DIALOG END hHelpForm&
                            END FUNCTION
                            ' ------------------------------------------------
                            SUB ShowHelpText(BYVAL hForm1&) ' make and display help form
                                LOCAL tt AS STRING
                                tt="This latest improved version of the math parser or interpreter includes a better interphase, more facilities, and more functions "+ _
                                "as well as error checking. "+$CRLF+$CRLF+ _
                                "By performing the calculations using extended-precision floating-point numbers, 18 digits of precision is obtained. Factorials "+ _
                                "up to 1754! can now be handled without overflow. "+$CRLF+$CRLF+ _
                                "A number of constants "+ _
                                "and conversions are available, making this math evaluator an advanced "+ _
                                "scientific calculator. Constants can stand alone, but conversions should always be preceeded by a number or numerical expression to work correctly."+$CRLF+$CRLF+ _
                                "You can easily add your own functions, constants "+ _
                                "and conversions to the source code."+$CRLF+$CRLF+ _
                                "Input of angles can be in degrees and "+ _
                                "radians. However, trigonometric output using the ARC functions will "+ _
                                "always be in radians, but you can always transform angles to radians and vice versa "+ _
                                "using the built-in conversions."+$CRLF+$CRLF+ _
                                "Input of your math expression can be done "+ _
                                "using the keyboard or by clicking the items in the list boxes. "+$CRLF+$CRLF+ _
                                "Expressions and functions should be entered strictly according to standard "+ _
                                "algebraic syntax rules. Operators and expressions which can be used are:  "+ _
                                "+  - *  /  \  ^  !  (  )  <  =  >  <>  >=  <=  in addition to those shown "+ _
                                "in the large list box. "+$CRLF+$CRLF+ _
                                "The Operator Precedence follows as closely as possible that used by PowerBasic - see the section on ""Operator Precedence"" in the PowerBasic help file. "+ _
                                "The only exception is the unary negation operator which in this program does not have a special priority following exponentiation. "+ _
                                "However, operations inside parentheses always have the highest priority and are always evaluated first. "+ _
                                "Thus by using parentheses in the right places you can always obtain the operator precedence you need for your purpose. "+$CRLF+$CRLF+ _
                                "The following operator precedence is used: "+$CRLF+ _
                                "1.  parentheses ( )"+$CRLF+ _
                                "2.  unary operators (factorials (!) )"+$CRLF+ _
                                "3.  one argument functions"+$CRLF + _
                                "4.  exponentiation (^) (power expressions)"+$CRLF + _
                                "5.  multiplication (*) and floating-point division (/)"+$CRLF + _
                                "6.  integer division (\)"+$CRLF + _
                                "7.  modulo (MOD)"+$CRLF + _
                                "8.  addition (+), subtraction (-)"+$CRLF + _
                                "9.  relational operators (<, <=, =, >=, >, <> )"+$CRLF + _
                                "10. NOT, ISFALSE and ISTRUE"+$CRLF + _
                                "11. AND"+$CRLF + _
                                "12. OR and XOR (exclusive OR)"+$CRLF+ _
                                "13. EQV (equivalence)"+$CRLF + _
                                "14. IMP (implication)"+$CRLF+$CRLF+ _
                                "Many thanks to Gafny Jacob, who provided the original code, which has "+ _
                                "been considerably changed and improved. Thanks to Achilles B. Mina "+ _
                                "for free to use code concerning conversions and constants. Thanks "+ _
                                "to Tony Burcham and Gunar Zagars for valuable contributions "+ _
                                "concerning error checking and overflow indication. Also many thanks to "+ _
                                "the whole PowerBasic forum for great inspiration. "+$CRLF+$CRLF+ _
                                "Good luck! -- June 29, 2005 -- Erik Christensen -- [email protected]"
                                LOCAL Style&
                                Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %DS_CENTER
                                DIALOG NEW hForm1&, "Math Evaluator Help", , , 300*CF, 200*CF, Style&,  TO hHelpForm&
                                CONTROL ADD BUTTON, hHelpForm&, %HelpExitButton,  "E&xit", 260*CF, 184*CF, 37*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_HelpExit
                                CONTROL ADD TEXTBOX, hHelpForm&, %HelpText,tt, 3*CF, 3*CF, 294*CF,176*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR %ES_READONLY OR %ES_LEFT OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
                                CONTROL SET COLOR hHelpForm&,%HelpText, RGB(0,0,255), RGB(255,255,255)
                                CONTROL SEND hHelpForm&,%HelpText,%WM_SETFONT,GetStockObject(%SYSTEM_FONT),%TRUE
                                DIALOG SHOW MODAL hHelpForm&
                            END SUB
                            ' ------------------------------------------------
                            CALLBACK FUNCTION CBF_FORM1_BUTTONHELP
                                CALL ShowHelpText(hForm1&)
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                            END FUNCTION
                            ' ------------------------------------------------
                            CALLBACK FUNCTION CBF_FORM1_BUTTONABOUT
                                LOCAL St AS STRING
                                St="Math expression evaluator with built-in constants and conversions for PBWin70. Program version 1.41   -   June 29, 2005"+$CRLF+$CRLF+ _
                                "By Erik Christensen, Copenhagen, Denmark       [email protected]"+$CRLF+$CRLF+ _
                                "The use of this Public Domain program and its consequences are your own responsibility. However, any comment you may have is welcome."+$CRLF+$CRLF+ _
                                "Good Luck!"
                                MSGBOX St,%MB_ICONINFORMATION,"About this program"
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                            END FUNCTION
                            '
                            CALLBACK FUNCTION SubClassEditKeys
                                ' Subclass callback function for processing key messages in edit control (textbox).
                                SELECT CASE CBMSG
                                    CASE %WM_GETDLGCODE
                                        FUNCTION = %DLGC_WANTALLKEYS: EXIT FUNCTION
                                    CASE %WM_CHAR    ' Any character key at time of pressing
                                        SELECT CASE CBWPARAM   ' Holds the code of the key.
                                            ' Specify what action should be taken for each key code.
                                            CASE 65 TO 90, 97 TO 122 ' character signs A-Z and a-z
                                                LOCAL txt$,Res&
                                                txt$ = UCASE$(CHR$(CBWPARAM))
                                                IF ISTRUE(LOWRD(GetKeyState(%VK_SHIFT)) AND &H8000) THEN
                                                    ' If SHIFT is pressed while character key is
                                                    ' pressed, then scroll listbox to show items
                                                    ' beginning with that character.
                                                    ' (This is better than using "GetAsyncKeyState")
                                                    LOCAL flag& : flag = 0
                                                    DO  ' This loop serves to scroll to item just above any
                                                        ' missing first letter in the list box, e.g. J at present.
                                                        CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SELECTSTRING,-1, STRPTR(txt$) TO Res&
                                                        IF Res& = %LB_ERR THEN txt$ = CHR$(ASC(txt$)+1) : flag = 1 ' First letter missing - move on to next letter
                                                    LOOP UNTIL Res&<>%LB_ERR OR txt$ >= "Z"
                                                    IF Res&<>%LB_ERR THEN CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SETTOPINDEX,Res& - flag,0
                                                    CONTROL SEND hForm1&,%FORM1_LISTBOX1,%LB_SETCURSEL,-1,0  ' deselect any item
                                                    ListFlag = 1 ' set flag for removing this character from expression textbox.
                                                END IF
                                            CASE %VK_RETURN ' 13 ' ENTER pressed
                                                ListFlag = 0
                                                CALL analysis
                                                EXIT FUNCTION
                                            CASE ELSE ' No action to be taken here for the other keys.
                                                ListFlag = 0
                                        END SELECT
                                    CASE ELSE
                                        ListFlag = 0
                                END SELECT
                                ' Pass the message on to the original window procedure... the DDT engine!
                                FUNCTION = CallWindowProc(gOldSubClassEdit&, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
                            END FUNCTION
                            '
                            CALLBACK FUNCTION CBF_FORM1_CLEAREXPRESSION
                                CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, ""
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                                FUNCTION = %TRUE
                            END FUNCTION
                            '
                            CALLBACK FUNCTION CBF_FORM1_BUTTONDOANALYSIS
                                CALL analysis
                                FUNCTION = %TRUE
                            END FUNCTION
                            '
                            CALLBACK FUNCTION CBF_FORM1_BUTTONEXIT
                                LOCAL res&
                                res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                                IF res&=%IDYES THEN DIALOG END hForm1&
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                            END FUNCTION
                            '
                            SUB analysis
                                STATIC t AS STRING,t1 AS SINGLE,t2 AS SINGLE
                                LOCAL hCtl&,t3$,ii&, i&, k&
                                LOCAL Test$,LineCount&,FirstVisLine&,Res&,NN AS EXT
                                STATIC Number&, NotFirst&
                                '
                                ' Added June 10, 2005
                                DIM OpLog(1 TO 8) AS STATIC STRING
                                IF ISFALSE NotFirst THEN
                                    DATA "NOT","ISFALSE","ISTRUE","AND","OR","XOR","EQV","IMP"
                                    FOR i = 1 TO 8
                                        OpLog(i) = READ$(i)
                                    NEXT
                                    NotFirst& = %TRUE
                                END IF
                                '
                                FirstTime = %TRUE
                                CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,0,-1  ' select all text
                                CONTROL GET TEXT hForm1&, %FORM1_TEXTFORMULA TO Test$
                            
                            '    CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,0,-1
                            '    CONTROL SEND hForm1&, %FORM1_TEXTFORMULA,%EM_SETSEL,-1,0  ' deselect all text. Put caret at the end
                            
                                    INCR Number&
                                    t = t + "Evaluation "+STR$(Number&)+$CRLF
                                   ' t1 = TIMER ' START TIME
                                    t = t + "Expression:  " + Test$
                                    '
                                    ' Replace text with numeric expressions for conversions or constants
                                    FOR ii& = 0 TO NoEx
                                        IF INSTR(Test$,Extra(0,ii&)) THEN
                                            REPLACE Extra(0,ii&) WITH Extra(1,ii&) IN Test$
                                            Test$ = REMOVE$(Test$," ")
                                            REPLACE "**" WITH "*" IN Test$
                                        END IF
                                    NEXT
                                    '
                                    ' insert extra parentheses to ensure correct evaluation of logical expressions (June 10, 2005)
                                    Test$ = UCASE$(Test$)
                                    Test$ = REMOVE$(Test$," ")
                                    Test$ = "(" + Test$ + ")"
                                    FOR i = 1 TO 8
                                        k = 1
                                        DO
                                            k = INSTR(k, Test$, OpLog(i))
                                            IF ISTRUE k THEN Test$ = STRINSERT$(Test$, "(", k + LEN(OpLog(i))) : Test$ = STRINSERT$(Test$, ")", k) : k = k + 3
                                        LOOP UNTIL ISFALSE k
                                    NEXT
                                    '
                                    Test$ = REMOVE$(Test$, "()")  ' added June 29, 2005
                                    t3$ = STR$(Eval(Test$),18)
                                    t = t + ErrorTxt + $CRLF
                                    IF ErrorTxt ="" THEN
                                        t = t + "Result:  " + t3$ + $CRLF + $CRLF
                                    ELSE
                                        t = t + $CRLF + $CRLF
                                    END IF
                                  '  t2 = TIMER ' END TIME
                                  '  t = t + "Evaluation time in ms: "+FORMAT$(1000 * (t2 - t1),"####")+$CRLF
                                  '  t = t + $CRLF
                                    t = RIGHT$(t, 65535) ' To avoid exceding the capacity limit of the multiline textbox
                                    CONTROL SET TEXT hForm1&,%FORM1_TEXTRESULTS,t
                                    CONTROL HANDLE hForm1&, %FORM1_TEXTRESULTS TO hCtl&
                                    LineCount&=Edit_GetLineCount(hCtl&)
                                    FirstVisLine&=Edit_GetFirstVisibleLine(hCtl&)
                                    ' scroll down to last evaluation
                                    Res&=Edit_LineScroll(hCtl&,0,LineCount&-FirstVisLine&-5)
                                    CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                            END SUB
                            '
                            CALLBACK FUNCTION CallbackListbox
                                LOCAL CVal&, text$ ,text2$
                                LOCAL hEdit AS LONG
                                LOCAL lpStart AS LONG, lpEnd AS LONG
                                IF CBCTLMSG=%LBN_SELCHANGE THEN
                                    ' Get first and last position of the selection if any
                                    CONTROL SEND hForm1&,%FORM1_TEXTFORMULA, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
                                    CONTROL GET TEXT hForm1&,%FORM1_TEXTFORMULA TO text$
                                    ' Return Current Selection in CVal&
                                    CVal&=-1
                                    CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
                                    IF CVal& > -1 THEN ' valid selection
                                        LISTBOX GET TEXT CBHNDL , CBCTL TO text2$
                                        LOCAL cc&
                                        cc& = INSTR(text2$," ")
                                        IF cc& THEN text2$=LEFT$(text2$,cc&-1)
                                        cc&=0
                                        IF INSTR(text2$,"()") THEN cc&=1
                                        CONTROL SEND CBHNDL, CBCTL,%LB_SETCURSEL,-1,0
                                        text$=LEFT$(text$,lpStart)+text2$+MID$(text$,lpStart+1)
                                        CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, text$
                                        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,0,lpStart+LEN(text2$)-cc&
                                        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,-1,0
                                        CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                                        FUNCTION = %TRUE
                                    END IF
                                END IF
                            END FUNCTION
                            '
                            CALLBACK FUNCTION CallbackListbox2
                                LOCAL CVal&, text$ ,text2$
                                LOCAL hEdit AS LONG, le&
                                LOCAL lpStart AS LONG, lpEnd AS LONG
                                IF CBCTLMSG=%LBN_SELCHANGE THEN
                                    ' Get first and last position of the selection if any
                                    CONTROL SEND hForm1&,%FORM1_TEXTFORMULA, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
                                    CONTROL GET TEXT hForm1&,%FORM1_TEXTFORMULA TO text$
                                    ' Return Current Selection in CVal&
                                    CVal&=-1
                                    CONTROL SEND CBHNDL , CBCTL, %LB_GETCURSEL, 0,0 TO CVal&
                                    IF CVal& > -1 THEN ' valid selection
                                        LISTBOX GET TEXT CBHNDL, CBCTL TO text2$
                                        text2$ = TRIM$(text2$)
                                        CONTROL SEND CBHNDL, CBCTL,%LB_SETCURSEL,-1,0
                                        text$=LEFT$(text$,lpStart)+text2$+MID$(text$,lpStart+1)
                                        CONTROL SET TEXT hForm1&,%FORM1_TEXTFORMULA, text$
                                        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,0,lpStart+LEN(text2$)
                                        CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%EM_SETSEL,-1,0
                                        CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                                        FUNCTION = %TRUE
                                    END IF
                                END IF
                            END FUNCTION
                            ' ------------------------------------------------
                            SUB SizeListbox(BYVAL hDlg&,BYVAL id&,BYVAL Xp&,BYVAL Yp&,BYVAL W&,BYVAL H&,BYVAL UNflag&)
                                ' Resize LISTBOX while maintaining integral line height.
                                ' The built-in behavior of listbox is not satisfactory
                                ' when switching to and from horizontal scroll bar. Therefore,
                                ' the %LBS_NOINTEGRALHEIGHT style should be applied, so we
                                ' can control the whole process. The %WS_HSCROLL and %WS_VSCROLL
                                ' styles are also necessary.
                                STATIC t$
                                LOCAL I&,j&,TotalWidth&,Temp$,nResult&,nCount&,hDC&
                                LOCAL TotalHeight&,hCtr&,VS&,HS&
                                LOCAL rc AS RECT
                                LOCAL Si AS APISIZE
                                LOCAL hFont AS LONG
                                LOCAL VScrollBarWidth&,HScrollBarHeight&,ListboxItemHeight&
                                IF UNflag& THEN ' convert dialog units to pixels
                                    DIALOG UNITS hDlg&, Xp&, Yp& TO PIXELS Xp&, Yp&
                                    DIALOG UNITS hDlg&, W&, H& TO PIXELS W&, H&
                                END IF
                                CONTROL HANDLE hDlg&, id& TO hCtr&
                                ListboxItemHeight&  = SendMessage(hCtr&,%LB_GETITEMHEIGHT,0,0)
                                VScrollBarWidth&  = GetSystemMetrics(%SM_CXVSCROLL)
                                HScrollBarHeight& = GetSystemMetrics(%SM_CYHSCROLL)
                                '
                                ' Find maximum width string to determine if a horizontal scroll bar is needed.
                                ' Lance Edmonds is thanked for his example in the source code forum.
                                nCount = 1
                                hDC = GetDC(hCtr&)
                                hFont = SendMessage(hCtr&, %WM_GETFONT, 0, 0)
                                IF hFont THEN hFont = SelectObject(hDC, hFont)
                                j = SendMessage(hCtr&, %LB_GETCOUNT, 0, 0)
                                TotalHeight& = j * ListboxItemHeight& ' Total height of listbox content.
                                ' Enumerate the strings in the LISTBOX
                                FOR i = 0 TO j - 1
                                  nResult = SendMessage(hCtr&,%LB_GETTEXTLEN, i, 0)
                                  IF nResult THEN
                                    Temp = SPACE$(nResult)
                                    SendMessage hCtr&, %LB_GETTEXT, i, STRPTR(Temp)
                                    ' Get the width of the string. Addition of "N" provides a safety margin.
                                    GetTextExtentPoint32 hDC, BYCOPY Temp + "N", nResult + 1, Si
                                    ' Get the maximum width.
                                    nCount = MAX&(nCount, Si.cx)
                                  END IF
                                NEXT i
                                ' Set horizontal extent of the listbox. If this is larger than
                                ' listbox's physical width, a horizontal scroll bar is sutomatically added.
                                SendMessage hCtr&, %LB_SETHORIZONTALEXTENT, nCount, 0
                                ' Clean up
                                IF hFont THEN SelectObject hDC, hFont
                                ReleaseDC hCtr&, hDC
                                '
                                TotalWidth& = nCount
                                '
                                ' Assess if scrollbars will be displayed and make proper adjustments:
                                IF H& < TotalHeight& + HScrollBarHeight& THEN VS& = 1 ' Vertical scroll bar dependent on horizontal scroll bar
                                IF H& < TotalHeight& THEN VS& = VScrollBarWidth&      ' Vertical scroll bar certain
                                IF W& - 2 * GetSystemMetrics(%SM_CXEDGE)< TotalWidth& + VScrollBarWidth& THEN HS& = 1   ' Horizontal scroll bar dependent on vertical scroll bar
                                IF W& - 2 * GetSystemMetrics(%SM_CXEDGE)< TotalWidth& THEN HS& = HScrollBarHeight&      ' Horizontal scroll bar certain
                                IF HS& = HScrollBarHeight& AND VS& = 1 THEN VS& = VScrollBarWidth&
                                IF VS& = VScrollBarWidth& AND HS& = 1 THEN HS& = HScrollBarHeight&
                                IF VS& <= 1 AND HS& <= 1 THEN HS& = 0 AND VS& = 0
                                H& = H& - HS&
                                '
                                H& = INT(H&/ListboxItemHeight&) * ListboxItemHeight& _ ' Get integral lines height
                                          + 2 * GetSystemMetrics(%SM_CYEDGE) + 1 _     ' Add edge height (may be improved)
                                          + HS&                                        ' Add horizontal scroll factor
                                ' Set new position and size of listbox
                                ' The following approach always going from larger to smaller width gives
                                ' the best results.
                                MoveWindow hCtr&,Xp&,Yp&,W&+VScrollBarWidth&,H&,%TRUE
                                MoveWindow hCtr&,Xp&,Yp&,W&,H&,%TRUE
                            END SUB
                            '
                            CALLBACK FUNCTION EditFormulaProc
                                LOCAL hCtl&,j&,Result&
                                SELECT CASE CBMSG
                                    CASE %WM_INITDIALOG
                                        ' Resize LISTBOX while maintaining integral line height.
                                        CALL SizeListbox(hForm1&,%FORM1_LISTBOX1,140*CF,10*CF,248*CF,164*CF,1)
                                        InvalidateRect hForm1&, BYVAL %NULL , %TRUE
                                        UpdateWindow hForm1&
                                        CONTROL HANDLE hForm1&, %FORM1_TEXTFORMULA TO hCtl&
                                        gOldSubClassEdit& = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassEditKeys))
                                    CASE %WM_DESTROY
                                        ' Important! Remove the subclassing
                                        SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassEdit&
                                    CASE ELSE
                                END SELECT
                            END FUNCTION
                            '
                            CALLBACK FUNCTION CallbackTextFormula
                                LOCAL text$
                                LOCAL lpStart AS LONG, lpEnd AS LONG
                            
                                ' If pressed keyboard character was meant to scroll listbox, then remove it from the expression.
                                IF CBCTLMSG = %EN_CHANGE AND ListFlag = 1 THEN
                                    ' Get first and last position of the selection if any
                                    CONTROL SEND CBHNDL,CBCTL, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
                                    CONTROL GET TEXT CBHNDL, CBCTL TO text$
                                    ' Delete character just prior to caret.
                                    text$=LEFT$(text$,lpStart-1)+MID$(text$,lpStart+1)
                                    CONTROL SET TEXT CBHNDL, CBCTL, text$
                                    CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,lpStart-1,lpStart-1
                                    CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,-1,0  ' de-select text.
                                    ListFlag = 0
                                END IF
                                FUNCTION = %TRUE
                            END FUNCTION
                            ' ------------------------------------------------
                            CALLBACK FUNCTION CBF_RadioButtonRadians
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                                FUNCTION = %TRUE
                            END FUNCTION
                            ' ------------------------------------------------
                            CALLBACK FUNCTION CBF_RadioButtonDegrees
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                                FUNCTION = %TRUE
                            END FUNCTION
                            ' ----------------------------------------------------------------
                            FUNCTION PBMAIN()
                                LOCAL tt$,ni&,t$,LogPixelsY&
                                LOCAL hDC AS LONG
                                LOCAL CC1 AS INIT_COMMON_CONTROLSEX     
                                  
                                CC1.dwSize=SIZEOF(CC1)
                                CC1.dwICC=%ICC_WIN95_CLASSES
                                InitCommonControlsEX CC1
                                'Retrieves a handle of a display device context (DC) for the
                                'client area of the specified window (here the desktop).
                                hDC = GetDC(%HWND_DESKTOP)
                                '
                                'Retrieves device-specific information about the number
                                'of pixels per logical inch along the screen height
                                '(depends on screen resolution setting).
                                'This is important to define appropriate font sizes.
                                'LogPixelsY = 120 for large fonts and 96 for small fonts setting of Windows
                                LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
                                CF = 1 ' dialog conversion factor for large fonts setting
                                IF LogPixelsY = 96 THEN CF = 1.25 ' dialog conversion factor for small fonts setting
                                LOCAL Style&,Exstyle&,LabelStyle&,DWstyle&,ListStyle&
                                Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER' OR %WS_CLIPCHILDREN
                                ExStyle& = 0
                                LabelStyle& = %WS_CHILD OR %WS_VISIBLE OR %SS_LEFT
                            
                                DIALOG NEW 0, "Math expression evaluator with built-in constants and conversions for PBWin9.0", 0, 0,  392*CF, 260*CF, Style&, ExStyle& TO hForm1&
                            
                                CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL, "Enter expression using standard syntax:", 5*CF,168*CF,140*CF,12*CF, LabelStyle&
                                CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL2, "Result of expression evaluation:", 5*CF,191*CF,159*CF,12*CF, LabelStyle&
                                LOCAL tx$
                                tx$ = "Easy Find:   SHIFT + First Letter    -    Then click to select:"
                                CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL3, tx$, 142*CF,2*CF,248*CF,12*CF, LabelStyle&
                                CONTROL ADD LABEL, hForm1&,  %FORM1_LABEL4, "Click to select:", 5*CF,117*CF,134*CF,12*CF, LabelStyle&
                            
                                ListStyle&=%WS_CHILD OR %WS_VISIBLE OR %WS_VSCROLL OR %WS_TABSTOP OR %LBS_SORT
                                CONTROL ADD LISTBOX, hForm1&, %FORM1_LISTBOX1, , 140*CF,10*CF,248*CF,164*CF,ListStyle& OR %WS_HSCROLL OR %LBS_NOINTEGRALHEIGHT ,%WS_EX_CLIENTEDGE CALL CallbackListbox
                                CONTROL SET COLOR hForm1&,%FORM1_LISTBOX1, RGB(0,0,225), RGB(255,255,230)
                                CONTROL SEND hForm1&,%FORM1_LISTBOX1,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
                                ListStyle& = ListStyle& - %LBS_SORT
                                CONTROL ADD LISTBOX, hForm1&, %FORM1_LISTBOX2, , 3*CF,125*CF,134*CF,40,ListStyle& OR %LBS_MULTICOLUMN  ,%WS_EX_CLIENTEDGE CALL CallbackListbox2
                                LOCAL cv&: cv=22: IF CF>1 THEN cv=21
                                CONTROL SEND hForm1&, %FORM1_LISTBOX2, %LB_SETCOLUMNWIDTH, cv,0
                                CONTROL SET COLOR hForm1&,%FORM1_LISTBOX2, RGB(0,0,225), RGB(255,255,230)
                                CONTROL SEND hForm1&,%FORM1_LISTBOX2,%WM_SETFONT,GetStockObject(%SYSTEM_FONT),%TRUE
                                DWstyle& = %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR %ES_READONLY OR %ES_LEFT OR %WS_TABSTOP
                            
                                CONTROL ADD TEXTBOX, hForm1&,%FORM1_DESCRIBE,"",3*CF,10*CF,134*CF,104*CF,DWstyle&,%WS_EX_CLIENTEDGE
                                CONTROL SET COLOR hForm1&,%FORM1_DESCRIBE, RGB(230,0,0), RGB(255,240,255)
                                CONTROL SEND hForm1&,%FORM1_DESCRIBE,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),%TRUE
                                CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXTFORMULA,  "", 3*CF, 176*CF, 386*CF, 12*SQR(CF), _
                                    %ES_AUTOHSCROLL OR %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_UPPERCASE ,%WS_EX_CLIENTEDGE CALL CallbackTextFormula
                                CONTROL SET COLOR hForm1&,%FORM1_TEXTFORMULA, RGB(0,0,225), RGB(255,255,255)
                            
                                CONTROL SEND hForm1&,%FORM1_TEXTFORMULA,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
                                CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXTRESULTS,  "", 3*CF, 199*CF, 386*CF, 40*CF, _
                                  %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR _
                                    %ES_LEFT OR %WS_VSCROLL OR %ES_NOHIDESEL OR %ES_AUTOVSCROLL OR %WS_TABSTOP, _
                                    %WS_EX_CLIENTEDGE
                                CONTROL SET COLOR hForm1&,%FORM1_TEXTRESULTS, RGB(0,0,225), RGB(235,255,255)
                            
                                CONTROL SEND hForm1&,%FORM1_TEXTRESULTS,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
                                '
                                CONTROL ADD LABEL, hForm1&,  %LabelRadioButtonAction,  "Input Angles in:",5*CF,155*CF,48*CF,10*CF
                                CONTROL ADD OPTION, hForm1&,  %RadioButtonRadians,  "Radians", 56*CF,154*CF,38*CF, 10*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_AUTORADIOBUTTON OR %WS_GROUP OR %WS_TABSTOP CALL CBF_RadioButtonRadians
                                CONTROL ADD OPTION, hForm1&,  %RadioButtonDegrees,  "Degrees", 96*CF,154*CF,38*CF, 10*CF CALL CBF_RadioButtonDegrees
                                CONTROL SEND hForm1&,%RadioButtonRadians,%BM_SETCHECK,%BST_CHECKED,0
                                '
                                CONTROL ADD BUTTON, hForm1&,  %FORM1_CLEAREXPRESSION,  "&Clear expression", 3*CF, 244*CF, 70*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_CLEAREXPRESSION
                                CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONDOANALYSIS,  "&Evaluate expression", 78*CF, 244*CF, 180*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONDOANALYSIS
                                CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONHELP,  "&Help", 264*CF, 244*CF, 34*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONHELP
                                CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONABOUT,  "&About", 304*CF, 244*CF, 34*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONABOUT
                                CONTROL ADD BUTTON, hForm1&,  %FORM1_BUTTONEXIT,  "E&xit", 344*CF, 244*CF, 45*CF, 12*CF, _
                                    %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONEXIT
                                '
                                tt="Expressions and functions should be entered strictly according to standard "+ _
                                "algebraic syntax rules. GIGO you know."+$CRLF+$CRLF+"Type or build expression by selecting its components in "+ _
                                "the list boxes. "+ $CRLF+$CRLF+ "Good Luck!"+$CRLF+"Erik Christensen"+$CRLF+"[email protected]"
                                CONTROL SET TEXT hForm1&,%FORM1_DESCRIBE,tt
                                CONTROL SET FOCUS hForm1&,%FORM1_TEXTFORMULA
                            
                                '
                                DATA "ARCSINH() - Arc (Inverse) Hyperbolic Sine","ARCCOSH() - Arc (Inverse) Hyperbolic Cosine","ARCTANH() - Arc (Inverse) Hyperbolic Tangent","ARCSECH() - Arc (Inverse) Hyperbolic Secant"
                                DATA "ARCCSCH() - Arc (Inverse) Hyperbolic Cosecant","ARCCOTH() - Arc (Inverse) Hyperbolic Cotangent","ARCSIN() - Arc (Inverse) Sine","ARCCOS() - Arc (Inverse) Cosine"
                                DATA "ARCSEC() - Arc (Inverse) Secant","ARCCSC() - Arc (Inverse) Cosecant","ARCCOT() - Arc (Inverse) Cotangent","SINH() - Hyperbolic Sine","TANH() - Hyperbolic Tangent"
                                DATA "SECH() - Hyperbolic Secant","CSCH() - Hyperbolic Cosecant","COTH() - Hyperbolic Cotangent","SEC() - Secant","CSC() - Cosecant"
                                DATA "COT() - Cotangent","SIN() - Sine","COS() - Cosine","TAN() - Tangent","ATN() - Arc (Inverse) Tangent","LN() - Natural Log (base E)"
                                DATA "EXP2() - Exponentiation of 2 or Antilog 2","EXP10() - Exponentiation of 10 or Antilog 10"
                                DATA "EXP() - Exponentiation of E or Antilog E","SQR() - Square Root","LOG10() - Common Log (base 10)","ABS() - Absolute Value","LOG2() - Log (base 2)","LOG() - Natural Log (base E)"
                                DATA "AND - Logical AND","XOR - Logical XOR (Exclusive OR)","OR - Logical OR","MOD - MOD (Modulo)","IMP - Logical IMP (Implication)"
                                DATA "EQV - Logical EQV (Equivalence)","NOT - NOT","ISTRUE - Logical Truth","ISFALSE - Logical Falsity","CEIL() - Ceiling"
                                DATA "FRAC() - Fractional Part","FIX() - Truncate To Integer","SGN() - Sign","PI# - Constant (3.14159..)","E# - Constant (2.71828..)","**1**"
                                ' EXP must come after EXP2 and EXP10
                                ' LOG must come after LOG2 and LOG10
                                ni = 1
                                LOCAL kk&
                                DO WHILE READ$(ni) <> "**1**"
                                    t = READ$(ni)
                                    IF INSTR(t,"()") THEN
                                        t = t + " Function"
                                    ELSE
                                        IF INSTR(t,"#") THEN EXIT IF
                                        t = t + " Operator"
                                    END IF
                                    LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t
                                    REDIM PRESERVE CheckArr(ni)
                                    kk& = INSTR(t,"()")
                                    IF kk& THEN t = LEFT$(t,kk&-1)
                                    CheckArr(ni) = t
                                    INCR ni
                                LOOP
                                '
                                DATA "1","+","2","-","3","*","4","/","5","\","6","^","7","("
                                DATA "8",")","9","=","0","<",".",">","E","!","**2**"
                            
                                INCR ni
                                DO WHILE READ$(ni) <> "**2**"
                                    t = READ$(ni)
                                    LISTBOX ADD hForm1&, %FORM1_LISTBOX2, "  "+t
                                    INCR ni
                                LOOP
                                '
                                REDIM Extra(1,0)
                                INCR ni
                                NoEx=-1
                                ' Read conversions
                                DO WHILE READ$(ni) <> "**3**"
                                    INCR NoEx
                                    REDIM PRESERVE Extra(1,NoEx)
                                    t = UCASE$(READ$(ni))
                                    LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t + " - Conversion"
                                    Extra(0,NoEx) = t
                                    INCR ni
                                    Extra(1,NoEx) = READ$(ni)
                                    INCR ni
                                LOOP
                                '
                                DATA "Foot_TO_meter"                                    , "*1/ 3.28084"
                                DATA "Meter_TO_foot"                                    , "* 3.28084"
                                DATA "Inch_TO_centimeter"                               , "* 2.54"
                                DATA "Centimeter_TO_inch"                               , "*1 / 2.54"
                                DATA "Kilometer_TO_mile"                                , "*1 / 1.609344"
                                DATA "Mile_TO_kilometer"                                , "* 1.609344"
                                DATA "Inch_TO_foot"                                     , "*1 / 12"
                                DATA "Foot_TO_inch"                                     , "* 12"
                                DATA "Yard_TO_meter"                                    , "*1 / 1.093613"
                                DATA "Meter_TO_yard"                                    , "* 1.093613"
                                DATA "Fathom_TO_meter"                                  , "* 1.8288"
                                DATA "Meter_TO_fathom"                                  , "*1 / 1.8288"
                                DATA "Mile_TO_light-year"                               , "*1 / 5880000000000"
                                DATA "Light-year_TO_mile"                               , "* 5880000000000"
                                DATA "Parsec_TO_light-year"                             , "* 3.261643"
                                DATA "Light-year_TO_parsec"                             , "*1 / 3.261643"
                                DATA "Square_ft_TO_square_m"                            , "*1 / 10.76391"
                                DATA "Square_m_TO_square_ft"                            , "* 10.76391"
                                DATA "Square_in_TO_square_cm"                           , "* 6.4516"
                                DATA "Square_cm_TO_square_in"                           , "*1 / 6.4516"
                                DATA "Hectare_TO_acre"                                  , "* 2.471054"
                                DATA "Acre_TO_hectare"                                  , "*1 / 2.471054"
                                DATA "Pound_TO_kilogram"                                , "*1 / 2.204623"
                                DATA "Kilogram_TO_pound"                                , "* 2.204623"
                                DATA "Ton_(metric)_TO_Kilogram"                         , "* 1000"
                                DATA "Kilogram_TO_ton_(metric)"                         , "*1 / 1000"
                                DATA "Ton_(US)_TO_Kilogram"                             , "* 907.18474"
                                DATA "Kilogram_TO_ton_(US)"                             , "*1 / 907.18474"
                                DATA "Ton_(UK)_TO_Kilogram"                             , "* 1016.046909"
                                DATA "Kilogram_TO_ton_(UK)"                             , "*1 / 1016.046909"
                                DATA "Ounce_(avoirdupois)_TO_gram"                      , "* 28.349551"
                                DATA "Gram_TO_ounce_(avoirdupois)"                      , "*1 / 28.349551"
                                DATA "Ounce_(troy)_TO_gram"                             , "* 31.103508"
                                DATA "Gram_TO_ounce_(troy)"                             , "*1 / 31.103508"
                                DATA "Fahrenheit_TO_Celsius"                            , "*1 / 1.8 - 32 / 1.8"
                                DATA "Celsius_TO_Fahrenheit"                            , "* 1.8 + 32"
                                DATA "Celsius_TO_Kelvin"                                , "*1 + 273.16"
                                DATA "Kelvin_TO_Celsius"                                , "*1 - 273.16"
                                DATA "Gallon_(US_dry)_TO_liter"                         , "* 4.404884"
                                DATA "Liter_TO_gallon_(US_dry)"                         , "*1 / 4.404884"
                                DATA "Gallon_(US_liquid)_TO_liter"                      , "* 3.785412"
                                DATA "Liter_TO_gallon_(US_liquid)"                      , "*1 / 3.785412"
                                DATA "Quart_(US_dry)_TO_gallon_(US_dry)"                , "*1 / 4"
                                DATA "Gallon_(US_dry)_TO_quart_(US_dry)"                , "* 4"
                                DATA "Pint_TO_liter_(US_dry)"                           , "* 0.55061"
                                DATA "Liter_TO_pint_(US_dry)"                           , "*1 / 0.55061"
                                DATA "Pint_TO_liter_(US_liquid)"                        , "* 0.473176"
                                DATA "Liter_TO_pint_(US_liquid)"                        , "*1 / 0.473176"
                                DATA "Cubic_ft_TO_cubic_m"                              , "*1 / 35.314667"
                                DATA "Cubic_m_TO_cubic_ft"                              , "* 35.314667"
                                DATA "Horsepower_(elec.)_TO_watt"                       , "* 745.7"
                                DATA "Watt_TO_horsepower_(elec.)"                       , "*1 / 745.7"
                                DATA "Horsepower_(metric)_TO_watt"                      , "* 735.499"
                                DATA "Watt_TO_horsepower_(metric)"                      , "*1 / 735.499"
                                DATA "BTU/hour_TO_watt"                                 , "* 0.293071"
                                DATA "Watt_TO_BTU/hour"                                 , "*1 / 0.293071"
                                DATA "Kilowatt_TO_watt"                                 , "* 1000"
                                DATA "Watt_TO_kilowatt"                                 , "*1 / 1000"
                                DATA "Kph_TO_mph"                                       , "*1 / 1.609344"
                                DATA "Mph_TO_kph"                                       , "* 1.609344"
                                DATA "Knot_TO_mph"                                      , "* 1.150778"
                                DATA "Mph_TO_knot"                                      , "*1 / 1.150778"
                                DATA "Meter/sec_TO_ft/sec"                              , "* 3.28084"
                                DATA "Ft/sec_TO_meter/sec"                              , "*1 / 3.28084"
                                DATA "Second_TO_minute"                                 , "*1 / 60"
                                DATA "Minute_TO_second"                                 , "* 60"
                                DATA "Minute_TO_hour"                                   , "*1 / 60"
                                DATA "Hour_TO_minute"                                   , "* 60"
                                DATA "Minute_TO_day"                                    , "*1 / 1440"
                                DATA "Day_TO_minute"                                    , "* 1440"
                                DATA "Day_TO_hour"                                      , "* 24"
                                DATA "Hour_TO_day"                                      , "*1 / 24"
                                DATA "Psi_TO_pascal"                                    , "* 6894.757"
                                DATA "Pascal_TO_psi"                                    , "*1 / 6894.757"
                                DATA "Psi_TO_atmosphere"                                , "* 0.068046"
                                DATA "Atmosphere_TO_psi"                                , "*1 / 0.068046"
                                DATA "Psi_TO_kg/sqcm"                                   , "* 0.070307"
                                DATA "Kg/sqcm_TO_psi"                                   , "*1 / 0.070307"
                                DATA "Degrees_TO_radians"                               , "* 1.74532925199432958E-2
                                DATA "Radians_TO_degrees"                               , "*1 / 1.74532925199432958E-2
                                ' **************************************
                                ' You may insert other conversions here.
                                ' **************************************
                                DATA "**3**"
                                '
                                ' Read constants
                                INCR ni
                                DO WHILE READ$(ni) <> "**4**"
                                    INCR NoEx
                                    REDIM PRESERVE Extra(1,NoEx)
                                    t = UCASE$(READ$(ni))
                                    LISTBOX ADD hForm1&, %FORM1_LISTBOX1, t + " - Constant"
                                    Extra(0,NoEx) = t
                                    INCR ni
                                    Extra(1,NoEx) = READ$(ni)
                                    INCR ni
                                LOOP
                                '
                                DATA "Acceleration_of_gravity_(m/sec²)"                 , "9.80665"
                                DATA "Dry_air_density_at_STP_(kg/m³)"                   , "1.293"
                                DATA "Light_speed_in_a_vacuum_(m/sec)"                  , "299792458"
                                DATA "Solar_constant_(watts/m²)"                        , "1340"
                                DATA "Sound_speed_at_STP_(m/sec)"                       , "331.4"
                                DATA "Standard_atmosphere_(nt/m²)"                      , "101300"
                                DATA "Earth_equatorial_radius_(m)"                      , "6378000"
                                DATA "Earth_escape_velcity_(m/sec)"                     , "11186"
                                DATA "Earth_magnetic_dipole_moment_(amp-m²)"            , "6.400E21"
                                DATA "Earth_mass_(kg)"                                  , "5.983E24"
                                DATA "Earth_mean_angular_rotational_speed_(rads/sec)"   , ".0000729"
                                DATA "Earth_mean_density_(kg/m³)"                       , "5522"
                                DATA "Earth_mean_orbital_speed_(m/sec)"                 , "29770"
                                DATA "Earth_polar_radius_(m)"                           , "6357000"
                                DATA "Earth_volume_(m³)"                                , "1.087E21"
                                DATA "Alpha_particle_mass_(kg)"                         , "6.64465598E-27"
                                DATA "Electron_charge-mass_ratio_(coul/kg)"             , "175881961000"
                                DATA "Electron_rest_mass_(kg)"                          , "9.10938188E-31"
                                DATA "Muon_rest_mass_(kg)"                              , "1.88353109E-28"
                                DATA "Neutron_rest_mass_(kg)"                           , "1.67492716E-27"
                                DATA "Proton_rest_mass_(kg)"                            , "1.67262158E-27"
                                DATA "Atomic_mass_constant_(kg)"                        , "1.66053873E-27"
                                DATA "Avogadro_constant_(1/mole)"                       , "6.02214199E23"
                                DATA "Boltzmann_constant_(joule/K)"                     , "1.3806503E-23"
                                DATA "Elementary_charge_(coul)"                         , "1.602176462E-19"
                                DATA "Faraday_constant_(coul/mole)"                     , "96485.3415"
                                DATA "Gravitational_constant_(nt-m²/kg²)"               , ".000000000066726"
                                DATA "Permeability_constant_(henry/m)"                  , "1.25663706143E-6"
                                DATA "Permittivity_constant_(farad/m)"                  , "8.85418781762E-12"
                                DATA "Planck_constant_(joule-sec)"                      , "6.62606876E-34"
                                DATA "Rydberg_constant_(1/m)"                           , "10973731.568549"
                                DATA "Stefan-Boltzmann_constant_(watt/m²K4)"            , ".000000056704"
                                DATA "Universal_gas_constant_(joule/K-mole)"            , "8.314472"
                                DATA "Wien_displacement_constant_(m-K)"                 , ".00290"
                                ' ************************************
                                ' You may insert other constants here.
                                ' ************************************
                                DATA "**4**"
                                '
                                REDIM Trig(35)
                                Trig(1) = "ARCSINH"
                                Trig(2) = "ARCCOSH"
                                Trig(3) = "ARCTANH"
                                Trig(4) = "ARCSECH"
                                Trig(5) = "ARCCSCH"
                                Trig(6) = "ARCCOTH"
                                Trig(7) = "ARCSIN"
                                Trig(8) = "ARCCOS"
                                Trig(9) = "ARCSEC"
                                Trig(10) = "ARCCSC"
                                Trig(11) = "ARCCOT"
                                Trig(12) = "SINH"
                                Trig(13) = "TANH"
                                Trig(14) = "SECH"
                                Trig(15) = "CSCH"
                                Trig(16) = "COTH"
                                Trig(17) = "SEC"
                                Trig(18) = "CSC"
                                Trig(19) = "COT"
                                Trig(20) = "SIN"
                                Trig(21) = "COS"
                                Trig(22) = "TAN"
                                Trig(23) = "ATN"
                                Trig(24) = "LOG" ' natural log or ln (logE)
                                Trig(25) = "EXP"
                                Trig(26) = "SQR"
                                Trig(27) = "CLG" ' log10
                                Trig(28) = "ABS"
                                Trig(29) = "TLG" ' log2
                                Trig(30) = "CEIL"
                                Trig(31) = "FIX"
                                Trig(32) = "FRAC"
                                Trig(33) = "SGN"
                                Trig(34) = "ETO" ' EXP2
                                Trig(35) = "ETE" ' EXP10
                                DIALOG SHOW MODAL hForm1& , CALL EditFormulaProc
                            END FUNCTION
                            ' ------------------------------------------------

                            Comment


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

                              Thanks all for the leads.
                              Rod
                              I want not 'not', not Knot, not Knott, not Nott, not knot, not naught, not nought, but aught.

                              Comment

                              Working...
                              X