XProfan

DEF GetSysColor(1)!"USER32","GetSysColor"
declare Edit&,e%,eins&,zwei&,drei&,vier&,fünf&,sechs&,sieben&,acht&,neun&,null&
declare komma&,plus&,minus&,mal&,geteilt&,gleich&,clear&,off&,del&,info&,ans$,ergebnis!
WindowStyle 24
Window 10,10-250,250
cls GetSysColor(15)
WindowTitle "Taschenrechner"
Edit& = Create("Edit",%HWnd,"",20,20,200,20)
eins& = Create("Button",%HWnd,"1",20,60,30,25)
zwei& = Create("Button",%HWnd,"2",60,60,30,25)
drei& = Create("Button",%HWnd,"3",100,60,30,25)
vier& = Create("Button",%HWnd,"4",20,100,30,25)
fünf& = Create("Button",%HWnd,"5",60,100,30,25)
sechs& = Create("Button",%HWnd,"6",100,100,30,25)
sieben& = Create("Button",%HWnd,"7",20,140,30,25)
acht& = Create("Button",%HWnd,"8",60,140,30,25)
neun& = Create("Button",%HWnd,"9",100,140,30,25)
null& = Create("Button",%HWnd,"0",20,180,30,25)
komma& = Create("Button",%HWnd,".",60,180,30,25)
plus& = Create("Button",%HWnd,"+",140,60,30,25)
minus& = Create("Button",%HWnd,"-",140,100,30,25)
mal& = Create("Button",%HWnd,"*",140,140,30,25)
geteilt& = Create("Button",%HWnd,":",140,180,30,25)
gleich& = Create("Button",%HWnd,"=",100,180,30,25)
clear& = Create("Button",%HWnd,"C",180,100,40,25)
del& = Create("Button",%HWnd,"Del",180,140,40,25)
off& = Create("Button",%HWnd,"Off",180,60,40,25)
info& = Create("Button",%HWnd,"?",180,180,40,25)

whilenot e%

    waitinput
    waitinput

    if getfocus(eins&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "1"

    elseif getfocus(zwei&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "2"

    elseif getfocus(drei&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "3"

    elseif getfocus(vier&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "4"

    elseif getfocus(fünf&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "5"

    elseif getfocus(sechs&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "6"

    elseif getfocus(sieben&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "7"

    elseif getfocus(acht&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "8"

    elseif getfocus(neun&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "9"

    elseif getfocus(null&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "0"

    elseif getfocus(plus&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "+"

    elseif getfocus(minus&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "-"

    elseif getfocus(mal&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "*"

    elseif getfocus(geteilt&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "/"

    elseif getfocus(komma&)

        ans$ = Val(GetText$(Edit&))
        SetText Edit&,ans$ + "."

    elseif getfocus(clear&)

        SetText Edit&,""

    elseIf Getfocus(off&)

        end

    elseif getfocus(info&)

        MessageBox("Title:\t\tTaschenrechner\t\nAutor:\t\tJulian Schmidt\nVersion:\t\t1.0\nErstellungsdatum:\t5.11.2010","I N F O",64)

    elseif getfocus(del&)

        SetText Edit&,ans$

    elseif getfocus(gleich&)

        ergebnis! = Val(GetText$(Edit&))
        ans$ = ergebnis!
        SetText Edit&,ans$

    endif

endwhile

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