Math-Calc (Taschenrechner für Mittelstand) von D2006

Aloha, den Code hatte ich vor ein paar Tagen erstellt. Nun hat mich der Taschenrechner für Arme auf die Idee gebracht, ihn zu veröffentlichen. Vom Prinzip: Ihr gebt beispielsweise: "((8-3)*(4-7))/((2+3)*(4-7))" ein und der Code spuckt: "-3.666667" aus. [Was natürlich stimmt] Bisher volle Unterstützung von: Addition, Subtraktion, Multiplikation, Division, Klammern, 1 Variable ("x" oder "X") Unter Beachtung von Punkt vor Strich und Klammern immer zuerst. Die Variable wird im folgendem Code als "Antwortspeicher" genutzt, also das letzte Ergebnis. [code:1:92b8248ba7] ;##### Math-Calc ;##### © 2003 ;##### Daniel Liebetrau ;##### Bei Benutzung bitte Credits-Eintrag Graphics 1024,768,32 SetBuffer BackBuffer() Cls Flip Cls font=LoadFont("Arial",18) SetFont font While Not KeyHit(1) ;Aufruf der Eingaberoutine dat$=bbin(50,10) ;Aufruf der Lösung mit altem x#-Wert als x-Variable x#=math_calc(dat$,x#) Cls Text 50,10,dat$ Text 50+StringWidth(dat$),30,cl(x#) Flip WaitKey() WaitKey() Cls Flip Cls Flip Wend End ; für folgendes siehe 2 Float#-Funktionen (Code-Archiv) Function cl$(xdat#) dat$=Str$(xdat#) For t=Len(dat$) To 1 Step -1 g$=Mid$(dat$,t,1) h=g$ If h=0 Then dat$=Left$(dat$,Len(dat$)-1) If g$="." Then Exit Else Exit EndIf Next Return dat$ End Function ; die eigentliche Funktion Function math_calc#(dat$,var#) Local b2=0,b1=0, b=0 Local number$[100],nr=0, num=0, nummer$="", kl=0 ;kl steht für Klammern dat$=dat$+" " For t=1 To Len(dat$) g$=Mid$(dat$,t,1) If g$="x" Or g$="X" Then If num=1 Then num=0 nr=nr+1 number[nr]="*" EndIf If kl=0 Then nr=nr+1 number[nr]="N"+var# Else number[nr]=number[nr]+Str$(var#) EndIf EndIf b=0 If Asc(g$)>47 And Asc(g$)<58 Then b=1 If Asc(g$)=46 Or Asc(g$)=94 Then b=1 If b=1 Then If num=0 And kl=0 Then nr=nr+1:number[nr]="N" num=1 number[nr]=number[nr]+g$ EndIf b1=0 If g$="+" Or g$="-" Or g$="/" Or g$="*" Then b1=1 If num=1 And b1=1 Then num=0 If b1=1 And kl=0 Then nr=nr+1:number[nr]=g$ If b1=1 And kl>0 Then number[nr]=number[nr]+g$ b2=0 If g$="(" Or g$=")" Then b2=1 If b2=1 Then If num=1 And kl=0 Then num=0 nr=nr+1 number[nr]="*" EndIf num=2 If kl=0 Then nr=nr+1 If g$="(" Then kl=kl+1 If kl>1 Then number[nr]=number[nr]+"(" EndIf If g$=")" Then kl=kl-1 If kl>0 Then number[nr]=number[nr]+")" EndIf If kl=0 Then number[nr]="N"+math_calc#(number[nr],var#) num=1 EndIf EndIf If num=1 And b+b1+b2=0 Then num=0 Next For t=1 To nr g$=number[t] If g$="*" Then v1#=Right$(number[t-1],Len(number[t-1])-1) v2#=Right$(number[t+1],Len(number[t+1])-1) number[t-1]="N"+Str$(v1*v2) For i=t To nr number[i]=number[i+2] Next nr=nr-2 t=0 EndIf If g$="/" Then v1#=Right$(number[t-1],Len(number[t-1])-1) v2#=Right$(number[t+1],Len(number[t+1])-1) If v2#=0 Then Return 0 number[t-1]="N"+Str$(v1/v2) For i=t To nr number[i]=number[i+2] Next nr=nr-2 t=0 EndIf Next For t=1 To nr g$=number[t] If g$="+" Then v1#=Right$(number[t-1],Len(number[t-1])-1) v2#=Right$(number[t+1],Len(number[t+1])-1) number[t-1]="N"+Str$(v1+v2) For i=t To nr number[i]=number[i+2] Next nr=nr-2 t=0 EndIf If g$="-" Then v1#=Right$(number[t-1],Len(number[t-1])-1) v2#=Right$(number[t+1],Len(number[t+1])-1) number[t-1]="N"+Str$(v1-v2) For i=t To nr number[i]=number[i+2] Next nr=nr-2 t=0 EndIf Next If number[1]<>"" Then v#=Right$(number[1],Len(number[1])-1) Else v#=0 Return v# End Function ; Eingaberoutine Function bbin$(xdat,ydat) dat$="" Repeat adat=GetKey() If adat>47 And adat<58 Then dat$=dat$+Chr$(adat) If adat=46 Then dat$=dat$+Chr$(adat) op$=" +-*/()xX" For t=1 To Len(op$) h$=Mid$(op$,t,1) If adat=Asc(h$) Then dat$=dat$+Chr$(adat) Next Text xdat,ydat,dat$+" " Color 0,0,0 Rect xdat+StringWidth(dat$),ydat,StringWidth("0"),FontHeight() Color 255,255,255 Flip If KeyHit(14) And Len(dat$)>0 Then dat$=Left$(dat$,Len(dat$)-1) Until KeyHit(28) Or KeyHit(156) Return dat$ End Function [/code:1:92b8248ba7] Achtung, zur Zeit kann man noch keine Negativen Zahl eingeben, außer so: -x = "0-x" Warte auf Kritik und Ideen MfG

===

von ???

Hallo. Ich hatte auch mal so was geschrieben. Da geht allerdings alles perfekt. :) EDIT: Dieser Code darf man auch ohne Credits verwenden. Hier der Code: [code:1:6e233a62f5]; Written by ShadowTurtle aka KHP - 03. 05. 2002 Print "Term Emu. : 10+5 = " + MathToString$("10+5") Print "BB Term : 10+5 = " + (10+5) Print Print "Term Emu. : 10-((1+(1-2))-1) = " + MathToString$("10-((1+(1-2))-1)") Print "BB Term : 10-((1+(1-2))-1) = " + (10-((1+(1-2))-1)) Print Print "Term Emu. : 5*3*(2+5)*3 = " + MathToString$("5*3*(2+5)*3") Print "BB Term : 5*3*(2+5)*3 = " + (5*3*(2+5)*3) Print Print "Term Emu. : 2+(10+(10)*-1)*20+5 = " + MathToString$("2+(10+(10)*-1)*20+5") Print "BB Term : 2+(10+(10)*-1)*20+5 = " + (2+(10+(10)*-1)*20+5) Print Print "Term Emu. : 5*3*(2+5)*3 = " + MathToString$("5*3*(2+5)*3") Print "BB Term : 5*3*(2+5)*3 = " + (5*3*(2+5)*3) Print Print "Term Emu. : (5+2)*-1 = " + MathToString$("(5+2)*-1") Print "BB Term. : (5+2)*-1 = " + ((5+2)*-1) Print Print "Term Emu. : (5+2)*-1 = " + MathToString$("(10*2)+(11*3)*(18-9*16+(2*4))") Print "BB Term : (10*2)+(11*3)*(18-9*16+(2*4)) = " + ((10*2)+(11*3)*(18-9*16+(2*4))) WaitKey End Function MathToString$(TheMath$, unit = 0, divnow = 0) Local MyParam$ = "*/^+-", MyNumbs$ = "0123456789.", MyDivParam$ = "*/^" Local Ziffer$, ScanPos, MathAnswer#, MathArt$, MathPower#, OldMathPower# Local Scan, ScanNumber$, OldScanNumber$, MathScan$, MyScanText$ Local bscan, bscannow, bscanhave, ScanPosA, ScanPosB Local deScan, deMathScan$, deMath Local debsScan MathScan$ = Replace(TheMath$, " ", "") : debsScan = 1 While bscan < Len(MathScan$) bscan = bscan + 1 If Mid$(MathScan$, bscan, 1) = "(" Then ScanPosA = bscan : bscannow = 1 While bscannow If Mid$(MathScan$, bscan, 1) = "(" Then bscanhave = bscanhave + 1 If Mid$(MathScan$, bscan, 1) = ")" Then bscanhave = bscanhave - 1 If bscanhave = 0 Then bscannow = 0 bscan = bscan + 1 If KeyDown(1) Then End Wend ScanPosB = bscan MyScanText$ = Mid$(MathScan$, ScanPosA+1, ScanPosB - ScanPosA - 2) MyScanText$ = MathToString$(MyScanText$, unit + 1) MathScan$ = Replace(MathScan$, Mid$(MathScan$, ScanPosA, ScanPosB - ScanPosA), MyScanText$) bscan = 0 End If If KeyDown(1) Then End Wend .NewMathScan deMathScan$ = MathScan$ Scan = InMid$(MathScan$, MyParam$) If Scan Then ScanNumber$ = Mid$(MathScan$, 1, Scan-1) MathScan$ = Mid$(MathScan$, Scan) MathAnswer = val2(ScanNumber$) Else Return MathScan$ End If deScan = 1 While Not MathScan$ = "" uu$ = MathScan$ MathArt$ = Mid$(MathScan$, 1, 1) MathScan$ = Mid$(MathScan$, 2) If Mid$(MathScan$,1,1) = "-" Then MathPower# = -1 MathScan$ = Mid$(MathScan$, 2) Else MathPower# = 1 End If Scan = InMid$(MathScan$, MyParam$) OldScanNumber$ = ScanNumber$ OldMathPower# = MathPower# ScanNumber$ = Mid$(MathScan$, 1, Scan-1) MathScan$ = Mid$(MathScan$, Len(ScanNumber$)+1) If MathArt$ = "+" Then MathAnswer = MathAnswer + (val2(ScanNumber$)*MathPower#) ElseIf MathArt$ = "-" Then MathAnswer = MathAnswer - (val2(ScanNumber$)*MathPower#) ElseIf MathArt$ = "*" Then MathAnswer = (val2(OldScanNumber$)*OldMathPower#) * (val2(ScanNumber$)*MathPower#) If MathPower# = -1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "*-" + ScanNumber$, "-" + Str$(MathAnswer)) ElseIf MathPower# = 1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "*" + ScanNumber$, Str$(MathAnswer)) End If Goto NewMathScan ElseIf MathArt$ = "/" Then MathAnswer = (val2(OldScanNumber$)*OldMathPower#) / (val2(ScanNumber$)*MathPower#) If MathPower# = -1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "/-" + ScanNumber$, "-" + Str$(MathAnswer)) ElseIf MathPower# = 1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "/" + ScanNumber$, Str$(MathAnswer)) End If Goto NewMathScan ElseIf MathArt$ = "^" Then MathAnswer = (val2(OldScanNumber$)*OldMathPower#) ^ (val2(ScanNumber$)*MathPower#) If MathPower# = -1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "^-" + ScanNumber$, "-" + Str$(MathAnswer)) ElseIf MathPower# = 1 Then MathScan$ = Replace(deMathScan$, OldScanNumber$ + "^" + ScanNumber$, Str$(MathAnswer)) End If Goto NewMathScan Else Return "SYNTAX ERROR" End If Wend Return Str(MathAnswer) End Function Function InMid$(A$, B$) ; in benutzung Local C, Q, W C = 0 For Q = 1 To Len(A$) For W = 1 To Len(B$) If (Mid$(A$, Q, 1) = Mid$(B$, W, 1)) And C = 0 Then C = Q : Exit Next If C>0 Then Exit Next Return C End Function Function val2#(sstring$) Local temp#=0 Local decimal=0 Local sign=1 Local a Local b Local c Local base=10 a=Instr(sstring$,"-",1) If a Then negative=-1 b=Instr(sstring$,"&",a+1) If b Then Select Mid$(sstring$,a+1,1) Case "B", "b" base=2 a=b+1 Case "O", "o" base=8 a=b+1 Case "H", "h" base=16 a=b+1 Default base=10 End Select End If decimal=0 For b=a+1 To Len(sstring$) c=Asc(Mid(sstring$,b,1)) Select c Case 44 ;"," Goto skip Case 45 ;"-" sign=-sign Case 46 ;"." decimal=1 Case 48,49,50,51,52,53,54,55,56,57 ;"0" To "9" temp#=temp*base+c-48 If decimal Then decimal=decimal*base Case 65,66,67,68,69,60 ;"A" to "F" If base=16 Then temp#=temp#*base+c-55 If decimal Then decimal=decimal*base Else Goto fini EndIf Case 97,98,99,100,101,102 ;"a" to "f" If base=16 Then temp#=temp#*base+c-87 If decimal Then decimal=decimal*base Else Goto fini EndIf Default Goto fini End Select .skip Next .fini If decimal Then temp#=temp#/decimal If negative = -1 Then Return -(temp#*sign) Else Return temp#*sign End If End Function[/code:1:6e233a62f5]

===

von ???

Mist jetzt auch noch konkurenz (und auch noch viel besser) :wink:

===

von ???

nee. Des ganze war nur ein 30 Min. Projekt. Ich weis auch selber, dass man da noch viel Optimieren muss. cu

===

von ???

sag mal, spielt das bei euch keine Rollen ob bei "Print" das "" fehlt oder bei Waitkey das (). Bei mir geht das dann nicht. (hab B+) MfG

===

von ???

@D2006: Also bei B2D ist das völlig egal...

Suche:
(unterstützt mySQL Wildcards ala %)

Titel:
Text:
Autor: