XProfan

DEF GetSysColor(1)!"USER32","GetSysColor"
declarar Edit&,e%,eins&,zwei&,drei&,vier&,fünf&,sechs&,sieben&,acht&,neun&,null&
declarar komma&,plus&,minus&,mal&,geteilt&,gleich&,clear&,off&,del&,info&,ans$,ergebnis!
Ventana de Estilo 24
Ventana 10,10-250,250
cls GetSysColor(15)
Título de la ventana "Taschenrechner"
Edit& = Crear("Edit",%HWnd,"",20,20,200,20)
eins& = Crear("Button",%HWnd,"1",20,60,30,25)
zwei& = Crear("Button",%HWnd,"2",60,60,30,25)
drei& = Crear("Button",%HWnd,"3",100,60,30,25)
vier& = Crear("Button",%HWnd,"4",20,100,30,25)
fünf& = Crear("Button",%HWnd,"5",60,100,30,25)
sechs& = Crear("Button",%HWnd,"6",100,100,30,25)
sieben& = Crear("Button",%HWnd,"7",20,140,30,25)
acht& = Crear("Button",%HWnd,"8",60,140,30,25)
neun& = Crear("Button",%HWnd,"9",100,140,30,25)
null& = Crear("Button",%HWnd,"0",20,180,30,25)
komma& = Crear("Button",%HWnd,".",60,180,30,25)
plus& = Crear("Button",%HWnd,"+",140,60,30,25)
minus& = Crear("Button",%HWnd,"-",140,100,30,25)
mal& = Crear("Button",%HWnd,"*",140,140,30,25)
geteilt& = Crear("Button",%HWnd,":",140,180,30,25)
gleich& = Crear("Button",%HWnd,"=",100,180,30,25)
clear& = Crear("Button",%HWnd,"C",180,100,40,25)
del& = Crear("Button",%HWnd,"Del",180,140,40,25)
off& = Crear("Button",%HWnd,"Off",180,60,40,25)
info& = Crear("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 como oft $2 en $1 vorkommt
DEF InStrExt(3) int(instr($(2),mid$($(1),&(3),len($(1))))+&(3))'sucht en $1 de &3 después de $2
DEF InStrLast(3) if(instrext($(1),$(2),&(3))>&(3),instrlast($(1),$(2),instrext($(1),$(2),&(3))),int(&(3)-1))'sucht en $1 de &3 después de el letzen vorkommen de $2, arbeitet Rekursiv.
'Wenn uno el Operatorzeichen ändern möchte braucht uno sólo el entsprechenden Signo ändern en el 2 folgenden Características ä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, así klein y doch una ganzer Taschenrechner
'Funktioniert sólo alleine si la Variables de Math Global gesetzt fueron (Ergebnis siempre en ma_v1& !)

proc mathcore

    parámetros ma_cmd$
    ma_s2$="«Æ»"'MathTabs-Signo = Beliebige Zeichenfolge el no en el Ausdruck vorkommen debería, sonst falsche Berechnung !
    ma_s4$=mathtabs(ma_cmd$,ma_s2$)'MathTabs conjunto
    ma_s3$=""
    ma_v1&=0
    ma_v2&=1

    whileloop ctstr(ma_s4$,ma_s2$)+1

        ma_s3$=substr$(ma_s4$,&bucle,ma_s2$)'Valor erfassen - Hier podría uno el Ausdruck zB. en una cierto Namen prüfen (para Variables en 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 con Klammern
'Haupt-Procedimiento el automáticamente sólo todos Klammern ausrechnet (si welche vorkommen)

proc math

    parámetros ma_prio$
    declarar ma_s1$,ma_s2$,ma_s3$,ma_s4$,ma_v1&,ma_v2&,ma_v3&,ma_v4&'en häufiger Benutztung Global conjunto (Ergebnis siempre en ma_v1& !)
    caso or(instr(")",ma_prio$)<instr("(",ma_prio$),neq(ctstr(ma_prio$,"("),ctstr(ma_prio$,")"))):ma_prio$="0"'ungültige Klammersetzung: Valor en Null conjunto

    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 de Innen después de 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$=en el$(str$(ma_v1&),ma_prio$,ma_v3&-1)

    wend

    mathcore ma_prio$
    volver ma_v1&

ENDPROC

declarar 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
    caso getfocus(bt1%):messagebox("Ergebnis: "+str$(math(gettext$(ed1%))),"Ergebnis:",0)
    ''Profano 7:
    'caso getfocus(bt1%):math gettext$(ed1%)
    'caso getfocus(bt1%):messagebox("Ergebnis: "+str$(&(0)),"Ergebnis:",0)

wend

end