Announcement

Collapse

Forum Guidelines

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

Gafny Jacob's math expression evaluator for Windows

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

  • Gafny Jacob's math expression evaluator for Windows

    ' gafny jacob's math expression evaluator modified and adapted for windows.
    '
    ' expressions and functions should be entered according to standard algebraic
    ' syntax rules.
    '
    ' you may very well improve this code with further syntax checking and
    ' more detailed error messages.
    '
    ' original source code by gafny jacob is here:
    http://www.powerbasic.com/support/pb...ad.php?t=22572
    ' the present code is changed in many places compared to the
    ' original code and some bugs have been corrected.
    '
    ' comments and suggestions for improvement should be posted here:
    http://www.powerbasic.com/support/pb...ead.php?t=7222
    '
    ' constants and conversions are built-in. these are based on free
    ' to use code by achilles b. mina found in another basic source
    ' code site. thus this math evaluator can also be used as an advanced
    ' scientific calculator.
    '
    ' still error checking of your input is not complete. so you must
    ' adhere strictly to the algebraic rules. gigo you know...
    '
    ' good luck and best wishes. erik christensen ---- e.chr@email.dk
    [CODE]
    #compile exe
    #register none
    #dim all
    '
    %form1_buttondoanalysis = 100
    %form1_buttonexit = 110
    %form1_textresults = 120
    %form1_textformula = 130
    %form1_label = 140
    %form1_label2 = 150
    %form1_label3 = 155
    %form1_describe = 160
    %form1_listbox1 = 170
    %labelradiobuttonaction = 175
    %radiobuttonradians = 180
    %radiobuttondegrees = 185

    '
    #include "win32api.inc"
    #include "commctrl.inc"
    '
    global goldsubclassedit&
    global hform1& ' handle of form
    global listtext$()
    global trig() as string
    global firsttime as long
    global errortxt as string
    global errormes as string
    global extra() as string, noex as long
    '
    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 double
    local i as long
    local r as double
    if inval > 170 then function = 0: exit function
    r = 1
    for i = 2 to inval
    r = r * i
    next
    function = r
    end function
    '
    function eval(formula as string) as double
    local instring as string
    local endpl as long
    local tmp as string
    local expr as string
    local saveexpr as string
    local exprval as double
    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 num as double
    local removeflag as long
    local validval as long

    local lftwing as string
    local ritwing as string
    local ritwingval as double
    local lftwingval as double
    local pl as long
    local valid as string
    local digit as string
    local i as long
    local result as double
    local numeric as string
    local tictac as long
    local l as long
    local de as string
    local block as string
    local mult as long
    local div as long
    local idiv as long
    local p1 as long
    local p2 as long
    local p3 as long
    local p4 as long
    local p5 as long
    local p6 as long
    '
    instring = formula
    '
    if istrue firsttime then ' "reshape" expression string to facilitate evaluation.
    '
    instring = ucase$(formula)
    replace " " with " in instring
    replace "#pi" with "3.14159265358979" in instring
    replace "#e" with "2.71828182845904" in instring
    replace "xor" with chr$(222) in instring ' to avoid confusion with or
    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 "mod" with chr$(254) 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
    '
    ' 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)))
    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)) & mid$(instring, plc + endpl)
    end if
    else
    exit do
    end if
    loop
    '
    ' remove multiple signs which may occur after evaluation of parantheses.
    replace "++" with "+" in instring
    replace "-+" with "-" in instring
    replace "+-" with "-" in instring
    replace "--" with "+" in instring
    '
    tmp = ltrim$(str$(val(instring)))
    '
    ' finished or not ?
    if (tmp = instring) or ("+" & tmp = instring) goto exitok
    '
    ' priority 1.
    ' evaluate unary operators
    '
    ' calculate factorials
    do
    pl = instr(instring, "!")
    if pl then
    ritwing = mid$(instring, pl + 1)
    for l = pl - 1 to max(pl - 5, 1) step -1
    if instr("12434567890", mid$(instring, l, 1)) = 0 then exit for
    if l = pl - 5 then errormes = "fault in factorial argument" : goto exitonerror
    next
    num = val(mid$(instring, 1 + l)) ' number for factorial calculation
    lftwing = left$(instring, l)
    if (num < 0) or (num > 170) then errormes = "too large or too small factorial argument" : goto exitonerror
    ' perform calculation and insert result in instring
    local fac# : fac# = factorial#(clng(num)) : if fac# = 0 then errormes = "invalid factorial calculation" : goto exitonerror
    instring = lftwing & ltrim$(str$(fac#)) & ritwing
    lftwing = ": num = 0: ritwing = "
    else
    exit do
    end if
    loop
    '
    ' priority 2:
    ' 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 ' get argument
    '
    ' angles measured in degrees - so transform to radians.
    if res&=%bst_checked and i<= 23 then ritwingval = ritwingval * 1.74532925199433e-2
    '
    select case i
    case 1: result = log(ritwingval + sqr(ritwingval * ritwingval + 1))
    case 2: result = log(ritwingval + sqr(ritwingval * ritwingval - 1))
    case 3: result = log((1 + ritwingval / 1 - ritwingval)) / 2
    case 4: result = log((sqr(-ritwingval * ritwingval + 1) + 1) / ritwingval)
    case 5: result = log((sgn(ritwingval) * sqr(ritwingval * ritwingval + 1) + 1) / ritwingval)
    case 6: result = log((ritwingval + 1) / (ritwingval - 1)) / 2
    case 7: result = atn(ritwingval / sqr(-ritwingval * ritwingval + 1))
    case 8: result = -atn(ritwingval / sqr(-ritwingval * ritwingval + 1)) + 1.57079637050629
    case 9: result = atn(ritwingval / sqr(ritwingval * ritwingval - 1)) + sgn(sgn(ritwingval) - 1) * 1.57079637050629
    case 10:result = atn(ritwingval / sqr(ritwingval * ritwingval - 1)) + (sgn(ritwingval) - 1) * 1.57079637050629
    case 11:result = atn(ritwingval) + 2 * atn(1)
    case 12:result = (exp(ritwingval) - exp(-ritwingval)) / 2
    case 13:result = (exp(ritwingval) - exp(-ritwingval)) / (exp(ritwingval) + exp(-ritwingval))
    case 14:result = 2 / (exp(ritwingval) + exp(-ritwingval))
    case 15:result = 2 / (exp(ritwingval) - exp(-ritwingval))
    case 16:result = (exp(ritwingval) + exp(-ritwingval)) / (exp(ritwingval) - exp(-ritwingval))
    case 17:result = 1 / cos(ritwingval)
    case 18:result = 1 / sin(ritwingval)
    case 19:result = 1 / tan(ritwingval)
    case 20:result = sin(ritwingval)
    case 21:result = cos(ritwingval)
    case 22:result = tan(ritwingval)
    case 23:result = atn(ritwingval)
    case 24:if ritwingval <= 0 then errormes = "ln or log <= 0" : goto exitonerror
    result = log(ritwingval)
    case 25:result = exp(ritwingval)
    case 26:if ritwingval < 0 then errormes = "square root < 0" :goto exitonerror
    result = sqr(ritwingval)
    case 27:if ritwingval <= 0 then errormes = "log10 <= 0" :goto exitonerror
    result = log10(ritwingval)
    case 28:result = abs(ritwingval)
    case 29:result = not ritwingval
    case 30:if ritwingval <= 0 then errormes = "log2 <= 0" :goto exitonerror
    result = log2(ritwingval)
    end select
    ' update instring with result and reset helper variables.
    instring = lftwing + ltrim$(str$(result)) + ritwing
    lftwing = ": numeric$ = ": ritwing = "
    ritwingval = 0: result = 0
    else
    exit do
    end if
    loop
    next
    '
    ' priority 3:
    ' calculate power expressions
    do
    pl = instr(instring, "^")
    if pl = 1 then errormes = "missing left argument in power espression" : goto exitonerror
    if pl > 1 then
    gosub getblock
    block = ltrim$(str$(lftwingval ^ ritwingval))
    instring = lftwing & block & ritwing
    if block = instring then ' fully evaluated.
    lftwing = ": ritwing = "
    lftwingval = 0:ritwingval = 0
    block = "
    goto exitok
    end if
    else
    exit do
    end if
    loop
    '
    ' priority 4:
    ' perform multiplication, division and mod
    do
    instrlen = len(instring)
    mult = instr(instring, "*") : if isfalse mult then mult = instrlen
    div = instr(instring, "/") : if isfalse div then div = instrlen
    idiv = instr(instring, "\") : if isfalse idiv then idiv = instrlen
    pmod = instr(instring, chr$(254)) : if isfalse pmod then pmod = instrlen
    pl = min(mult, pmod, div, idiv)
    if pl = instrlen then pl = 0
    if pl = 1 then errormes = "missing left argument in multiplication, division or mod expression" : goto exitonerror
    if pl > 1 then
    gosub getblock
    if pl = mult then
    result = lftwingval * ritwingval
    elseif pl = div then
    if ritwingval = 0 then errormes = "division by zero" : goto exitonerror
    result = lftwingval / ritwingval
    elseif pl = idiv then
    if ritwingval = 0 then errormes = "integer division by zero" : goto exitonerror
    result = lftwingval \ ritwingval
    elseif pl = pmod then
    if ritwingval = 0 then errormes = "division by zero in mod expression" : goto exitonerror
    result = lftwingval mod ritwingval
    end if
    block = ltrim$(str$(result))
    instring = lftwing & block & ritwing
    if block = instring then
    lftwing = "
    ritwing = "
    lftwingval = 0
    ritwingval = 0
    block = "
    result = 0
    goto exitok
    end if
    else
    exit do
    end if
    loop
    '
    ' priority 5:
    ' 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))) = 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 getblock
    if pl = padd then
    result = lftwingval + ritwingval
    elseif pl = psub then
    result = lftwingval - ritwingval
    end if
    tictac = 0
    block = ltrim$(str$(result))
    instring = lftwing & block & ritwing
    if block = instring or instring = "-1=-1" then
    lftwing = ": ritwing = "
    lftwingval = 0: ritwingval = 0
    block = ": result = 0: de = "
    goto exitok
    end if
    else
    exit do
    end if
    loop
    '
    ' priority 6:
    ' evaluate relational expressions plus and, or, xor
    '
    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
    if pl > 1 then
    gosub getblock
    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))
    instring = lftwing & block & ritwing
    if block = instring then
    lftwing = ": ritwing = "
    lftwingval = 0:ritwingval = 0
    block = ": result =0
    goto exitok
    end if
    else
    exit do
    end if
    loop
    '
    do
    pl = instr(instring, "and")
    if pl then
    gosub getblock
    pl = pl + 2
    gosub getrightwing
    result = lftwingval and ritwingval
    instring = lftwing & ltrim$(str$(result)) & ritwing
    lftwing = ": numeric = ": ritwing = "
    else
    exit do
    end if
    loop
    '
    do
    pl = instr(instring, "or")
    if pl then
    gosub getblock
    pl = pl + 1
    gosub getrightwing
    result = lftwingval or ritwingval
    instring = lftwing & ltrim$(str$(result)) & ritwing
    lftwing = ": numeric = ": ritwing = "
    else
    exit do
    end if
    loop
    '
    do
    pl = instr(instring, chr$(222)) ' xor
    if pl then
    gosub getblock
    result = lftwingval xor ritwingval
    instring = lftwing & ltrim$(str$(result)) & ritwing
    lftwing = ": numeric = ": ritwing = "
    else
    exit do
    end if
    loop
    '
    '
    exitok:
    function = val(instring)
    errortxt = "
    exit function
    '
    '
    exitonerror:
    errortxt = " error in expression: " + errormes
    function = 0
    exit function
    '
    '
    getblock:
    ' first 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
    '
    '
    getrightwing:
    ' then 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)) 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
    '
    end function ' eval
    '
    '
    callback function editdialogproc
    local hctl&,j&,result&
    select case cbmsg
    case %wm_initdialog
    control handle cbhndl, %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 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 %vk_return ' 13 ' enter pressed
    call analysis
    exit function
    case else ' no action to be taken here for the other keys.
    end select
    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_buttondoanalysis
    call analysis
    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&
    end function
    '
    sub analysis
    static t as string,t1 as single,t2 as single
    local hctl&,t3$,ii&
    local test$,linecount&,firstvisline&,res&,nn as double
    static number&
    firsttime = %true
    control send hform1&, %form1_textformula,%em_setsel,0,-1 ' select all text
    control set focus hform1&, %form1_textformula
    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
    replace extra(0,ii&) with extra(1,ii&) in test$
    replace " " with " in test$
    replace "**" with "*" in test$
    next
    '
    t3$ = str$(eval(test$))
    t = t + errortxt + $crlf
    t = t + "result: " + t3$ + $crlf
    t2 = timer ' end time
    t = t + "evaluation time in ms: "+format$(1000 * (t2 - t1),"####")+$crlf
    t = t + $crlf + $crlf
    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&-7)
    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
    control handle hform1&,%form1_textformula to hedit
    ' get first and last position of the selection if any
    sendmessage hedit, %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$
    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
    end if
    end if
    end function
    '
    callback function editformulaproc
    local hctl&,j&,result&
    select case cbmsg
    case %wm_initdialog
    control handle hform1&, %form1_textformula to hctl&
    goldsubclassedit& = setwindowlong(hctl&, %gwl_wndproc, codeptr(subclasseditkeys))
    case %wm_destroy
    ' important! remove the subclassing
    setwindowlong hctl&, %gwl_wndproc, goldsubclassedit&
    case else
    end select
    end function
    '
    ' ------------------------------------------------
    callback function cbf_radiobuttonradians
    control set focus hform1&,%form1_textformula
    end function
    ' ------------------------------------------------
    callback function cbf_radiobuttondegrees
    control set focus hform1&,%form1_textformula
    end function
    ' ------------------------------------------------
    function pbmain()
    local tt$,ni&,t$
    redim listtext$(100)
    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_center

    dialog new 0, "math expression evaluator with built-in constants and conversions", 0, 0, 392, 260, style&, exstyle& to hform1&

    control add label, hform1&, %form1_label, "enter expression using standard syntax rules:", 13,76,140,12, labelstyle&
    control add label, hform1&, %form1_label2, "results of expression evaluation:", 13,146,103,12, labelstyle&
    control add label, hform1&, %form1_label3, "built-in functions you can select by clicking:", 13,100,130,12, labelstyle&

    liststyle&=%ws_child or %ws_visible or %cbs_dropdownlist or %ws_vscroll or %ws_tabstop or %cbs_sort
    control add listbox, hform1&, %form1_listbox1, listtext$(), 150,100,220,50,liststyle&,%ws_ex_clientedge call callbacklistbox
    ' control set color hform1&,%form1_listbox1, rgb(0,0,200), rgb(255,255,230)

    control send hform1&,%form1_listbox1,%wm_setfont,getstockobject(%ansi_fixed_font),%true
    dwstyle& = %ws_child or %ws_visible or %es_multiline or %ws_vscroll or %es_readonly or %es_left

    control add textbox, hform1&,%form1_describe,",15,5,368,65,dwstyle&,%ws_ex_clientedge
    ' control set color hform1&,%form1_describe, rgb(0,0,200), rgb(255,255,230)
    control send hform1&,%form1_describe,%wm_setfont,getstockobject(%system_fixed_font),%true

    control add textbox, hform1&, %form1_textformula, ", 15, 85, 368, 12, _
    %es_autohscroll or %ws_child or %ws_visible or %ws_tabstop,%ws_ex_clientedge
    ' control set color hform1&,%form1_textformula, rgb(0,0,200), rgb(255,255,255)

    control send hform1&,%form1_textformula,%wm_setfont,getstockobject(%ansi_fixed_font),%true

    control add textbox, hform1&, %form1_textresults, ", 15, 155, 368, 60, _
    %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,200), rgb(255,255,255)

    control send hform1&,%form1_textresults,%wm_setfont,getstockobject(%ansi_fixed_font),%true
    '
    control add label, hform1&, %labelradiobuttonaction, "angles in:",85,114,60,10
    control add option, hform1&, %radiobuttonradians, "radians", 85,123,60, 10, _
    %ws_child or %ws_visible or %bs_autoradiobutton or %ws_group or %ws_tabstop call cbf_radiobuttonradians
    control add option, hform1&, %radiobuttondegrees, "degrees", 85,132,60, 10 call cbf_radiobuttondegrees
    control send hform1&,%radiobuttonradians,%bm_setcheck,%bst_checked,0
    '
    control add button, hform1&, %form1_buttondoanalysis, "&evaluate expression", 50, 230, 124, 12, _
    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_form1_buttondoanalysis
    control add button, hform1&, %form1_buttonexit, "e&xit", 259, 230, 124, 12, _
    %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop call cbf_form1_buttonexit
    tt="math expression evaluator for windows with built-in constants and conversions by erik christensen - e.chr@email.dk -. original code by gafny jacob. "
    tt=tt+"the constants and conversions are adaptations of codes provided by achilles b. mina. expressions and functions should be entered strictly according to standard "
    tt=tt+"algebraic syntax rules. operators and expressions which can be "
    tt=tt+"used are: + - * / ^ ! ( ) < = > <> >= <= in addition to those shown in the listbox below. good luck!"
    data "arcsinh()","arccosh()","arctanh()","arcsech()","arccsch()","arccoth()","arcsin()","arccos()"
    data "arcsec()","arccsc()","arccot()","sinh()","tanh()","sech()","csch()","coth()","sec()","csc()"
    data "cot()","sin()","cos()","tan()","atn()","ln()","log()","exp()","sqr()","log10()","abs()","not","log2()"
    data "and","or","xor","mod","#pi","#e","****"
    ni = 1
    do while read$(ni) <> "****"
    t = read$(ni)
    listbox add hform1&, %form1_listbox1, t
    incr ni
    loop
    '
    redim extra(1,0)
    incr ni
    noex=-1
    do while read$(ni) <> "****"
    incr noex
    redim preserve extra(1,noex)
    t = ucase$(read$(ni))
    listbox add hform1&, %form1_listbox1, t
    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"
Working...
X