XProfan

WindowTitle "Simple Parser"
Windowstyle 24
Window (%maxx-280)\2,(%maxy-210)\2 - 280,210
Var ed_calc&=Create("Edit",%hwnd,"5+(30*10)",10,10,width(%hwnd)-20,20)
Var lb_calc&=Create("ListBox", %hwnd, 0, 10, 40, width(%hwnd)-20, 100)
Var bt_calc&=Create("Button",%hwnd,"Ausrechnen",10,150,width(%hwnd)-20,25)
Declare calc$,pos_z1%

WhileNot iskey(27)

    Waitinput 300

    If getfocus(bt_calc&) or iskey(13)

        ClearList lb_calc&
        calc$=Translate$(Translate$(GetText$(ed_calc&),",",".")," ","")
        Addstring(lb_calc&,calc$)

        If (InStr(")",calc$)<>0) and (InStr("(",calc$)<>0)

            while (InStr(")",calc$)<>0) and (InStr("(",calc$)<>0)

                whileloop InStr(")",calc$),1,-1

                    pos_z1%=&loop
                    case (Mid$(calc$,pos_z1%,1)="(") :  break

                Endwhile

                calc$=Init_Parse(Mid$(calc$,pos_z1%+1,InStr(")",calc$)-(pos_z1%+1)),Mid$(calc$,1,pos_z1%-1),Mid$(calc$,InStr(")",calc$)+1,Len(calc$)-InStr(")",calc$)))

            Endwhile

        Else

            calc$=Translate$(Translate$(calc$,")",""),"(","")

        Endif

        Init_Parse(calc$)
        Setfocus(ed_calc&)

    Endif

EndWhile

Proc Init_Parse

    Parameters math$, str1$, str2$

    WhileNot iskey(27)

        Case GetString$(lb_calc&,Getcount(lb_calc&)-1)<>str1$+math$+str2$ : Addstring(lb_calc&,str1$+math$+str2$)

        If (InStr("^",math$)<>0)

            Parse("^")

        ElseIf (InStr("*",math$)<>0)

            Parse("*")

        ElseIf (InStr("+",math$)<>0)

            Parse("+")

        ElseIf (InStr("-",math$)<>0)

            Parse("-")

        ElseIf (InStr("\",math$)<>0) or (InStr("/",math$)<>0)

            Parse("\")

        Else

            Settext ed_calc&,math$
            break

        EndIf

    EndWhile

    Return str1$+math$+str2$

EndProc

Proc Parse

    Parameters op$
    Declare pos_z2%, z1$,z2$
    Var pos_op%=InStr(op$,math$)

    Whileloop pos_op%-1,0,-1

        If (Mid$(math$,&loop,1)="+") or (Mid$(math$,&loop,1)="-") or (Mid$(math$,&loop,1)="\") or (Mid$(math$,&loop,1)="/") or (Mid$(math$,&loop,1)="*") or (Mid$(math$,&loop,1)="^") or (trim$(Mid$(math$,&loop,1))="")

            z1$=Mid$(math$,&loop+1,pos_op%-(&loop+1))
            pos_z1%=&loop+1
            break

        Endif

    EndWhile

    Whileloop pos_op%+1,Len(math$)+1,1

        If (Mid$(math$,&loop,1)="+") or (Mid$(math$,&loop,1)="-") or (Mid$(math$,&loop,1)="\") or (Mid$(math$,&loop,1)="/") or (Mid$(math$,&loop,1)="*") or (Mid$(math$,&loop,1)="^") or (trim$(Mid$(math$,&loop,1))="")

            z2$=Mid$(math$,pos_op%+1,&loop-(pos_op%+1))
            pos_z2%=&loop
            break

        Endif

    EndWhile

    If ((op$="\") and (z2$="0"))

        math$="Division durch NULL!"

    Else

        Var erg$=Str$(If(op$="+",Val(z1$)+Val(z2$),If(op$="-",Val(z1$)-Val(z2$),If(op$="*",Val(z1$)*Val(z2$),If(op$="\",Val(z1$)/Val(z2$),If(op$="^",Val(z1$)^Val(z2$),"Error"))))))
        math$=Mid$(math$,1,pos_z1%-1)+erg$+Mid$(math$,pos_z2%,(Len(math$)+1)-pos_z2%)
        Settext ed_calc&,math$

    Endif

EndProc