XProfan

DEF CTStr(2) if(len($(2))=0,0,(len($(1))-len(translate$($(1),$(2),"")))/len($(2)))'zählt wie oft $2 in $1 vorkommt
DEF InStrExt(3) int(instr($(2),mid$($(1),&(3),len($(1))))+&(3))'sucht in $1 ab &3 nach $2
DEF InStrLast(3) if(instrext($(1),$(2),&(3))>&(3),instrlast($(1),$(2),instrext($(1),$(2),&(3))),int(&(3)-1))'sucht in $1 ab &3 nach dem letzen vorkommen von $2, arbeitet Rekursiv.
'Wenn man die Operatorzeichen ändern möchte braucht man nur die entsprechenden Zeichen ändern in den 2 folgenden Funktionen ändern
DEF MathTabs(2) translate$(translate$(translate$(translate$($(1),"+",$(2)),"-",$(2)),"*",$(2)),"/",$(2))
DEF GetMath(1) if($(1)="+",1,if($(1)="-",2,if($(1)="*",3,if($(1)="/",4,0))))
'Das Kernstück, so klein und doch ein ganzer Taschenrechner
'Funktioniert nur alleine wenn die Variablen aus Math Global gesetzt wurden (Ergebnis immer in ma_v1& !)

proc mathcore

    parameters ma_cmd$
    ma_s2$="«Æ»"'MathTabs-Zeichen = Beliebige Zeichenfolge die nicht im Ausdruck vorkommen sollte, sonst falsche Berechnung !
    ma_s4$=mathtabs(ma_cmd$,ma_s2$)'MathTabs setzen
    ma_s3$=""
    ma_v1&=0
    ma_v2&=1

    whileloop ctstr(ma_s4$,ma_s2$)+1

        ma_s3$=substr$(ma_s4$,&loop,ma_s2$)'Wert erfassen - Hier könnte man den Ausdruck zB. auf einen bestimmten Namen prüfen (für Variablen in Skriptsprachen).
        ma_v1&=if(ma_v2&=0,ma_v1&,if(ma_v2&=1,ma_v1&+val(ma_s3$),if(ma_v2&=2,ma_v1&-val(ma_s3$),if(ma_v2&=3,ma_v1&*val(ma_s3$),if(val(ma_s3$)<1,ma_v3&,ma_v1&/val(ma_s3$))))))
        ma_v2&=GetMath(mid$(ma_cmd$,len(ma_s3$)+1,1))
        ma_cmd$=del$(ma_cmd$,1,len(ma_s3$)+1)

    wend

endproc

'Berechnung mit Klammern
'Haupt-Prozedur die automatisch erst alle Klammern ausrechnet (wenn welche vorkommen)

proc math

    parameters ma_prio$
    declare ma_s1$,ma_s2$,ma_s3$,ma_s4$,ma_v1&,ma_v2&,ma_v3&,ma_v4&'bei häufiger Benutztung Global setzen (Ergebnis immer in ma_v1& !)
    case or(instr(")",ma_prio$)<instr("(",ma_prio$),neq(ctstr(ma_prio$,"("),ctstr(ma_prio$,")"))):ma_prio$="0"'ungültige Klammersetzung: Wert auf Null setzen

    whilenot ctstr(ma_prio$,"(")=0

        ma_v3&=instr("(",ma_prio$)+1
        ma_v4&=instrext(ma_prio$,")",ma_v3&)-1
        ma_v3&=ma_v3&+instrlast(mid$(ma_prio$,ma_v3&,ma_v4&-ma_v3&),"(",1)'Klammern von Innen nach Außen auflösen
        mathcore mid$(ma_prio$,ma_v3&,ma_v4&-ma_v3&)
        ma_prio$=del$(ma_prio$,ma_v3&-1,ma_v4&-ma_v3&+2)
        ma_prio$=ins$(str$(ma_v1&),ma_prio$,ma_v3&-1)

    wend

    mathcore ma_prio$
    return ma_v1&

endproc

declare ed1%,bt1%
window 20,20-420,150
drawtext 5,5,"Berechnung eingeben... (+ Add ; - Sub ; / Div ; * Mul ; ( ) Prio)"
ed1%=create("edit",%hwnd,"5+(30*(4/2)+10)",5,25,400,21)'5+((10/2)*10)-30
bt1%=create("button",%hwnd,"Berechnen",5,50,400,40)

whilenot %key=2

    waitinput
    'XProfan
    case getfocus(bt1%):messagebox("Ergebnis: "+str$(math(gettext$(ed1%))),"Ergebnis:",0)
    ''Profan 7:
    'case getfocus(bt1%):math gettext$(ed1%)
    'case getfocus(bt1%):messagebox("Ergebnis: "+str$(&(0)),"Ergebnis:",0)

wend

end