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&,à l'$,ergebnis!
Fenêtre Style 24
Fenêtre 10,10-250,250
cls GetSysColor(15)
Titre de la fenêtre "Taschenrechner"
Edit& = Créer("Edit",%HWnd,»,20,20,200,20)
eins& = Créer("Button",%HWnd,"1",20,60,30,25)
zwei& = Créer("Button",%HWnd,"2",60,60,30,25)
drei& = Créer("Button",%HWnd,"3",100,60,30,25)
vier& = Créer("Button",%HWnd,"4",20,100,30,25)
fünf& = Créer("Button",%HWnd,"5",60,100,30,25)
sechs& = Créer("Button",%HWnd,"6",100,100,30,25)
sieben& = Créer("Button",%HWnd,"7",20,140,30,25)
acht& = Créer("Button",%HWnd,"8",60,140,30,25)
neun& = Créer("Button",%HWnd,"9",100,140,30,25)
null& = Créer("Button",%HWnd,"0",20,180,30,25)
komma& = Créer("Button",%HWnd,".",60,180,30,25)
plus& = Créer("Button",%HWnd,"+",140,60,30,25)
minus& = Créer("Button",%HWnd,"-",140,100,30,25)
mal& = Créer("Button",%HWnd,"*",140,140,30,25)
geteilt& = Créer("Button",%HWnd,»,140,180,30,25)
gleich& = Créer("Button",%HWnd,"=",100,180,30,25)
clear& = Créer("Button",%HWnd,"C",180,100,40,25)
del& = Créer("Button",%HWnd,"Del",180,140,40,25)
off& = Créer("Button",%HWnd,"Off",180,60,40,25)
info& = Créer("Button",%HWnd,"?",180,180,40,25)

whilenot e%

    waitinput
    waitinput

    si getfocus(eins&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "1"

    elseif getfocus(zwei&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "2"

    elseif getfocus(drei&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "3"

    elseif getfocus(vier&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "4"

    elseif getfocus(fünf&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "5"

    elseif getfocus(sechs&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "6"

    elseif getfocus(sieben&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "7"

    elseif getfocus(acht&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "8"

    elseif getfocus(neun&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "9"

    elseif getfocus(null&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "0"

    elseif getfocus(plus&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "+"

    elseif getfocus(minus&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "-"

    elseif getfocus(mal&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "*"

    elseif getfocus(geteilt&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "/"

    elseif getfocus(komma&)

        à l'$ = Val(GetText $(Edit&))
        SetText Edit&,à l'$ + "."

    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&,à l'$

    elseif getfocus(gleich&)

        ergebnis! = Val(GetText $(Edit&))
        à l'$ = ergebnis!
        SetText Edit&,à l'$

    endif

endwhile

DEF CTStr(2) si(len($(2))=0,0,(len($(1))-len(translate$($(1),$(2),»)))/len($(2)))'zählt comment souvent $2 dans $1 vorkommt
DEF InStrExt(3) int(instr($(2),mid$($(1),&(3),len($(1))))+&(3))'cherchez dans $1 ab &3 pour $2
DEF InStrLast(3) si(instrext($(1),$(2),&(3))>&(3),instrlast($(1),$(2),instrext($(1),$(2),&(3))),int(&(3)-1))'cherchez dans $1 ab &3 pour dem letzen vorkommen de $2, arbeitet Rekursiv.
'si on qui Operatorzeichen changement voudrais braucht on seulement qui entsprechenden marque changement dans den 2 folgenden Funktionen changement
DEF MathTabs(2) translate$(translate$(translate$(translate$($(1),"+",$(2)),"-",$(2)),"*",$(2)),"/",$(2))
DEF GetMath(1) si($(1)="+",1,si($(1)="-",2,si($(1)="*",3,si($(1)="/",4,0))))
'cela Kernstück, so petite et doch un ganzer calculette
'Funktioniert seulement alleine si le Variablen aus Math Global gesetzt wurden (Ergebnis toujours dans ma_v1& !)

proc mathcore

    parameters ma_cmd$
    ma_s2$="«Æ»"'MathTabs-marque = Beliebige Zeichenfolge qui pas im Ausdruck vorkommen sollte, sonst falsche Berechnung !
    ma_s4$=mathtabs(ma_cmd$,ma_s2$)'MathTabs mettons
    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 - ici pourrait on den Ausdruck zB. sur une certain Namen vérifier (pour Variablen dans Skriptsprachen).
        ma_v1&=si(ma_v2&=0,ma_v1&,si(ma_v2&=1,ma_v1&+val(ma_s3$),si(ma_v2&=2,ma_v1&-val(ma_s3$),si(ma_v2&=3,ma_v1&*val(ma_s3$),si(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 avec Klammern
'tête-Procédure qui automatisch seulement alle Klammern ausrechnet (si quelle vorkommen)

proc math

    parameters ma_prio$
    declare ma_s1$,ma_s2$,ma_s3$,ma_s4$,ma_v1&,ma_v2&,ma_v3&,ma_v4&'chez häufiger Benutztung Global mettons (Ergebnis toujours dans ma_v1& !)
    cas or(instr(")",ma_prio$)<instr("(",ma_prio$),neq(ctstr(ma_prio$,"("),ctstr(ma_prio$,")"))):ma_prio$="0"'ungültige Klammersetzung: Wert sur zéro mettons

    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 dedans pour 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... (+ Ajouter ; - Sous ; / 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 %clé=2

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

Wend

end