' Gambas class file

' ToDo: Eingabealphabet für einen Scanner
' Eingabealphabet1: a b c d e f g h i k l n p q r s u x 
' Eingabealphabet2: 0..9 
' Eingabealphabet3: ( ) . * + - / 

PUBLIC xGlobal AS Float
PUBLIC bFlagFehler AS Byte     'XXXXX

PUBLIC SUB Form_Open()
' FMain.Center
  FMain.Border = 1
  FMain.Width = 357
  TextArea1.ReadOnly = TRUE
  txb_ArgumentAnfang.Text = "-5.0"
  txb_ArgumentEnde.Text = "5.0"
  txb_ArgumentDeltaX.Text = "0.5"
  txbTermEingabe.SetFocus
  FMain.Center
END

'----------------------------------------------------------------------------
PUBLIC FUNCTION anfang(zeichenkette AS String, zeichen AS String) AS String
  DIM position, anzahl AS Integer
  
  position = pos0(zeichen, zeichenkette)
  anzahl = position - 1
  RETURN Mid$(zeichenkette, 1, anzahl)  
END ' anfang(..)

PUBLIC FUNCTION copyab(zeichenkette AS String, i AS Integer) AS String
  DIM anzahl AS Integer
  
  anzahl = Len(zeichenkette) - i + 1
  RETURN Mid$(zeichenkette, i, anzahl)
END ' copyab(..)

PUBLIC FUNCTION ende(zeichenkette AS String, zeichen AS String) AS String
  DIM position, anzahl AS Integer
  
  position = pos0(zeichen, zeichenkette)
  anzahl = position + 1
  RETURN copyab(zeichenkette, anzahl)
END ' ende(..)
'----------------------------------------------------------------------------
PUBLIC FUNCTION pos0(zeichen AS String, zeichenkette AS String) AS Integer
' Funktion pos0 findet das Zeichen "+", "-"... NICHT innerhalb von Klammern
  DIM k, iAnzahlDerKlammern AS Integer
  
  iAnzahlDerKlammern = 0
  FOR k = Len(zeichenkette) TO 1 STEP -1
      IF Mid$(zeichenkette, k, 1) = "(" THEN INC iAnzahlDerKlammern 
      IF Mid$(zeichenkette, k, 1) = ")" THEN DEC iAnzahlDerKlammern 
      IF (iAnzahlDerKlammern = 0) AND IF (Mid$(zeichenkette, k, 1) = zeichen) THEN 
         RETURN k ' k Klammern gefunden
      ENDIF
  NEXT ' k 
  RETURN 0  'Keine Klammer gefunden ... 
END

'--- Selbstdefinierte Funktionen mit Fehlerbehandlung -----------------------

PUBLIC FUNCTION basis_hoch_n(fBasis AS Float, n AS Integer) AS Float
  DIM fPotenzwert AS Float
  DIM iExponent AS Integer
  
  IF n < 0 THEN 
     iExponent = - n
     fPotenzwert = 1.0 / basis_hoch_n(fBasis, iExponent) ' Rekursiver Aufruf!
  ELSE 
     fPotenzwert = 1
     WHILE n > 0
        IF n MOD 2 <> 0 THEN fPotenzwert = fPotenzwert * fBasis
        n = n DIV 2
        fBasis = fBasis * fBasis
     WEND 
  ENDIF ' n < 0
  RETURN fPotenzwert
END ' basis_hoch_n
'----------------------------------------------------------------------------
PUBLIC FUNCTION fakultaet(x AS Integer) AS Integer
  IF x = 0 OR IF x = 1 THEN 
     RETURN 1 
  ELSE 
    RETURN x * fakultaet(x - 1) ' Rekursiver Aufruf!
  ENDIF 
END ' fakultaet()
'----------------------------------------------------------------------------
PUBLIC FUNCTION division(fZaehler AS Float, fNenner AS Float) AS Float 
  DIM fQuotient AS Float
  
  TRY fQuotient = fZaehler / fNenner
  IF fNenner = 0.0 OR ERROR THEN 
     'Fehlerbehandlung("Division by zero")
  ELSE 
     RETURN fQuotient
  ENDIF 
END ' division(..)
'----------------------------------------------------------------------------
PUBLIC FUNCTION wurzel2(x AS Float) AS Float
  DIM fWurzelwert2 AS Float
   
  TRY fWurzelwert2 = Sqr(x)
  IF ERROR THEN 
     Message.Error("Fehler! Der Radikand ist negativ.") 
     RETURN Pi * 1E-17
  ELSE 
     RETURN fWurzelwert2
  ENDIF 
END ' wurzel(argument >= 0)
'----------------------------------------------------------------------------

PUBLIC FUNCTION TTR(s AS String) AS Float
  DIM u1, u2, u3, u4, u5, v2, v3, v4, v5 AS String
  DIM fReelleZahl AS Float
  
  s = Trim(s)
  IF Mid$(s, 1, 1) = "-" THEN s = "0" & s 'z.B. s='-7/3x+14' -> s='0-7/3x+14'
  
  u1 = Mid$(s, 1, 1)  'zum Beispiel u1 = 'e'
  u2 = Mid$(s, 1, 2)  'zum Beispiel u2 = 'ln'
  v2 = copyab(s, 3)  
  u3 = Mid$(s, 1, 3)  'zum Beispiel u3 = 'sin'
  v3 = copyab(s, 4)
  u4 = Mid$(s, 1, 4)  'zum Beispiel u4 = 'sqrt'
  v4 = copyab(s, 5)
  u5 = Mid$(s, 1, 5)  ' ?
  v5 = copyab(s, 6)
  
  '--- Rekursiver Ansatz nach einer Idee von Joachim Mohr
  '--- OPERATIONEN  UND FUNKTIONSKLASSE GRF ---------------------------------
  IF pos0("+", s) > 0 THEN 
     RETURN TTR(anfang(s, "+")) + TTR(ende(s, "+"))
  ELSE IF pos0("-", s) > 0 THEN 
     RETURN TTR(anfang(s, "-")) - TTR(ende(s, "-")) 
  ELSE IF pos0("*", s) > 0 THEN 
    RETURN TTR(anfang(s, "*")) * TTR(ende(s, "*")) 
  ELSE IF pos0("/", s) > 0 THEN 
    RETURN TTR(anfang(s, "/")) / TTR(ende(s, "/"))
  ' ELSE IF pos0("/", s) > 0 THEN 
  '   RETURN division(TTR(anfang(s, "/")), TTR(ende(s, "/"))) ---> gegenwärtig NICHT genutzt
  ELSE IF pos0("h", s) > 0 THEN 
    RETURN basis_hoch_n(TTR(anfang(s, "h")), TTR(ende(s, "h"))) 
  
  '--- Wurzelfunktionen -----------------------------------------------------
  ELSE IF u3 = "sqr" THEN     ' ---> Square root 
    RETURN wurzel2(TTR(v3))   ' ---> Eigene Wurzel-Funktion mit Fehlermeldung
  ELSE IF u3 = "cbr" THEN     ' ---> Cubic root  
    RETURN Cbr(TTR(v3)) 
  
  '--- Winkelfunktionen -----------------------------------------------------  
  ELSE IF u3 = "sin" THEN 
     RETURN Sin(TTR(v3))
  ELSE IF u3 = "cos" THEN 
     RETURN Cos(TTR(v3))
  ELSE IF u3 = "tan" THEN 
     RETURN Tan(TTR(v3))
  ELSE IF u3 = "rad" THEN 
     RETURN Rad(TTR(v3))
     
  '--- Exponential- und Logarithmusfunktionen ------------------------------  
  ELSE IF u5 = "exp10" THEN 
     RETURN Exp10(TTR(v5))
  ELSE IF u4 = "exp2" THEN 
     RETURN Exp2(TTR(v4))
  ELSE IF u3 = "exp" THEN 
     RETURN Exp(TTR(v3))
  '-----------------------
  ELSE IF u2 = "ln" THEN 
     RETURN Log(TTR(v2)) 
  ELSE IF u2 = "lg" THEN 
     RETURN Log10(TTR(v2))
  ELSE IF u2 = "lb" THEN 
     RETURN Log2(TTR(v2))    
     
  '--- Weitere Funktionen ---------------------------------------------------  
  ELSE IF u3 = "fak" THEN 
    RETURN fakultaet(TTR(v3))
  ELSE IF u3 = "abs" THEN 
    RETURN Abs(TTR(v3))
    
  ' Gauß'sche Klammerfunktion
  ' Für eine reelle Zahl x ist [x] = Int(x) die größte ganze Zahl, die kleiner oder gleich x ist.
  ELSE IF u3 = "int" THEN 
    RETURN Int(TTR(v3))  
    
  '--- Konstanten -----------------------------------------------------------
  ELSE IF u2 = "pi" OR IF u2 = "Pi" THEN ' Pi = 3,1415...
    RETURN Pi  
' ELSE IF u2 = "eu" THEN ' Eulersche Zahl eu = Exp(1) = e^1 = 2,718281...
'   RETURN Exp(1)  
  ELSE IF u1 = "e" THEN ' Eulersche Zahl e = Exp(1) = e^1 = 2,718281...
    RETURN Exp(1)  
  '--------------------------------------------------------------------------
  
  ELSE IF s <> "" AND Mid$(s, 1, 1) = "(" THEN   ' Klammern?
    s = Mid$(s, 2, Len(s) - 2)
    RETURN TTR(s) 
  ELSE IF s = "x" THEN 
    RETURN xGlobal 
  ELSE
    ' CStr(s) => Dezimal-Trennzeichen ist ein Punkt
    ' Val(s)  => Dezimal-Trennzeichen ist ein Komma
    TRY fReelleZahl = CStr(s) 
    IF NOT ERROR THEN 
       RETURN CStr(s)
    ELSE 
       Message.Error("Es ist ein Fehler aufgetreten!<br>Berechnung wird abgebrochen!")     'XXXXX
       bFlagFehler = 1    'XXXXX
    ENDIF 
  ENDIF
 
END ' TTR(..)

PUBLIC FUNCTION TA(s AS String, x AS Float) AS Float 'Termwert-Ausgabefunktion TA
  x = xGlobal 
  RETURN TTR(s)  
END

PUBLIC SUB btnWertetabelleAusgeben_Click()
  DIM x, y AS Float
  DIM term AS String
  DIM fArgumentAnfang AS Float
  DIM fArgumentEnde AS Float
  DIM fArgumentDeltaX AS Float
  
  '-----------------------------------------------------------------------
  IF txbTermEingabe.Text = "" THEN 
     Message.Error("Eingabefehler! Es fehlt die Funktion.")
     txbTermEingabe.SetFocus
     RETURN 
  ENDIF ' ERROR
  '-----------------------------------------------------------------------
  TRY fArgumentAnfang = CFloat(txb_ArgumentAnfang.Text)
  IF ERROR THEN 
     Message.Error("Eingabefehler beim Argument x_Anfang!")
     txb_ArgumentAnfang.SetFocus
     RETURN 
  ENDIF ' ERROR ArgumentAnfang
  '-----------------------------------------------------------------------
  TRY fArgumentEnde = CFloat(txb_ArgumentEnde.Text)
  IF ERROR THEN 
     Message.Error("Eingabefehler beim Argument x_Ende!")
     txb_ArgumentEnde.SetFocus
     RETURN 
  ENDIF ' ERROR ArgumentEnde
  '-----------------------------------------------------------------------  
  IF fArgumentEnde <= fArgumentAnfang THEN 
     Message.Error("Eingabefehler: Argument_Ende <= Argument_Anfang!")
     txb_ArgumentEnde.Text = ""
     txb_ArgumentEnde.SetFocus
     RETURN 
  ENDIF ' Bereichprüfung  
  '-----------------------------------------------------------------------
  TRY fArgumentDeltaX = CFloat(txb_ArgumentDeltaX.Text) 
  IF ERROR THEN 
     Message.Error("Eingabefehler bei Delta_x!")
     txb_ArgumentDeltaX.SetFocus
     RETURN 
  ENDIF ' ERROR ArgumentDeltaX
  '-----------------------------------------------------------------------
  IF fArgumentDeltaX < 0.001 THEN ' Minimum: 0.0001
     Message.Warning("Der Wert für Delta_x ist zu klein. Minimum = +0.001!")
     txb_ArgumentDeltaX.SetFocus
     RETURN 
  ENDIF ' ArgumentDeltaX < 0.0001
  '-----------------------------------------------------------------------
  
  
  xGlobal = fArgumentAnfang  '  -4 'Startwert
  term = txbTermEingabe.Text
  TextArea1.Clear
  TextArea1.Text = "            Argument          Funktionswert" & gb.NewLine &
                   "  ------------------------------------------------------------------------" & gb.NewLine
  REPEAT  
    y = TA(term, x)
    TextArea1.Text = TextArea1.Text & Chr$(9) & Format$(xGlobal, "0.000") & Chr$(9) & Chr$(9) & Format$(y, "0.000000") & Chr$(10)
    xGlobal = xGlobal + fArgumentDeltaX  '2. Summand repräsentiert die Schrittweite
    IF bFlagFehler = 1 THEN BREAK     'XXXXX
  UNTIL xGlobal > fArgumentEnde + 0.001 'Endwert (Endwert plus Delta-x. Nie mit = bei until arbeiten => Endlosschleife!)
  bFlagFehler = 0     'XXXXX
  
END ' WertetabelleAusgeben_Click()

PUBLIC SUB txbTermEingabe_Change()
  TextArea1.Clear
END ' txbTermEingabe_Change()

PUBLIC SUB txb_ArgumentAnfang_Change()
  TextArea1.Clear
END ' txb_ArgumentAnfang_Change()

PUBLIC SUB txb_ArgumentEnde_Change()
  TextArea1.Clear
END ' txb_ArgumentEnde_Change()

PUBLIC SUB txb_ArgumentDeltaX_Change()
  TextArea1.Clear
END ' txb_ArgumentDeltaX_Change()

PUBLIC SUB btnReset_Click()
  TextArea1.Clear
  txbTermEingabe.Clear
  txb_ArgumentAnfang.Text = "-5.0"
  txb_ArgumentEnde.Text = "5.0"
  txb_ArgumentDeltaX.Text = "0.5"
  txbTermEingabe.SetFocus
END ' Reset_Click()

PUBLIC SUB btnNotes_Click()
  IF FMain.Width = 357 THEN 
     FMain.Width = 931
  ELSE 
     FMain.Width = 357
  ENDIF 
END ' btnNotes_Click()

PUBLIC SUB btnProgrammEnde_Click()
  FMain.Close
END ' ProgrammEnde_Click()

