1:
2:
3:

2*3
-(4+5)*3^(2.3/5)+ln(8)
sin(4*x)*exp(-x/4)					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

var
  mp : TMathParser;
  e : Extended;
begin
  //ohne Variable
  mp:=TMathParser.Create;
  mp.SetVarLength(0);//nicht unbedingt erforderlich
  e:=mp.Parse('-(4+5)*3^(2.3/5)+ln(8)');
  mp.Free;
  //mit Variable
  mp:=TMathParser.Create;
  mp.SetVarLength(1);
  mp.VarArray[0].Name:='x';
  mp.VarArray[0].Value:=2;
  e:=mp.Parse('sin(4*x)*exp(-x/4)');
  mp.Free;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:

unit mparser;

interface

type
  TVar = record
    Name : string;
    Value : Extended;
  end;
  TVarArray = array of TVar;

  TMathParser = class(TObject)
  private
    FVarArray : TVarArray;
  published
    property VarArray : TVarArray read FVarArray write FVarArray;
    procedure SetVarLength(NewLength : Integer);
    function Parse(Term : string) : Extended;
  end;

implementation
uses
  SysUtils, Math;

const
  op : array[0..4] of Char = ('^','/','*','-','+');
  func : array[0..8] of string = ('exp','ln','sqrt','sin','cos','tan',
                                  'arcsin','arccos','arctan');
type
  TExpression = record
    Operator, Funct : Byte;
    Number : Extended;
  end;

procedure TMathParser.SetVarLength(NewLength : Integer);
begin
  SetLength(FVarArray,NewLength);
end;

function TMathParser.Parse(Term : string) : Extended;
var
  a : Byte;
  b, c : Integer;
  ex : array of TExpression;
  index : Integer;
  s : string;
begin
  Result:=0;
  if Length(Term) = 0 then Exit;
  Term:=LowerCase(Term);
  //ggf. führenden Operator hinzufügen
  if (Term[1] <> '-') and (Term[1] <> '+') then Term:='+'+Term;
  SetLength(ex,0);
  index:=0;
  while Length(Term) > 0 do
  begin
    index:=Length(ex);
    SetLength(ex,index+1);
    //Operator bestimmen
    ex[index].Operator:=255;
    for a:=0 to 4 do
      if Term[1] = op[a] then
      begin
        ex[index].Operator:=a;
        Break;
      end;
    Term:=Copy(Term,2,Length(Term)-1);
    //Funktion bestimmen
    ex[index].Funct:=255;
    for a:=0 to 8 do
      if Pos(func[a]+'(',Term) = 1 then
      begin
        ex[index].Funct:=a;
        Term:=Copy(Term,Length(func[a])+1,Length(Term));
        Break;
      end;
    //Wert bestimmen, bei Klammerausdruck diesen erneut parsen
    if Term[1] = '(' then
    begin
      c:=0;
      for b:=1 to Length(Term) do
      begin
        if Term[b] = '(' then Inc(c);
        if Term[b] = ')' then Dec(c);
        if c = 0 then Break;
      end;
      ex[index].Number:=Parse(Copy(Term,2,b-2));
      Term:=Copy(Term,b+1,Length(Term));
    end else
    begin
      b:=Length(Term)+1;
      for a:=0 to 4 do
      begin
        c:=Pos(op[a],Term);
        if (c < b) and (c > 0) then b:=c;
      end;
      s:=Copy(Term,1,b-1);
      Term:=Copy(Term,b,Length(Term));
      //Ist der Ausdruck eine Variable?
      for c:=0 to Length(FVarArray)-1 do
        if LowerCase(FVarArray[c].Name) = s then
        begin
          ex[index].Number:=FVarArray[c].Value;
          s:='';
          Break;
        end;
      if s <> '' then ex[index].Number:=StrToFloat(s);
    end;
  end;
  //Funktionen auf ihre zugeordnete Zahl anwenden
  for b:=0 to index do
    case ex[b].Funct of
      0 : ex[b].Number:=exp(ex[b].Number);
      1 : ex[b].Number:=ln(ex[b].Number);
      2 : ex[b].Number:=sqrt(ex[b].Number);
      3 : ex[b].Number:=sin(ex[b].Number);
      4 : ex[b].Number:=cos(ex[b].Number);
      5 : ex[b].Number:=tan(ex[b].Number);
      6 : ex[b].Number:=arcsin(ex[b].Number);
      7 : ex[b].Number:=arccos(ex[b].Number);
      8 : ex[b].Number:=arctan(ex[b].Number);
    end;
  //Operanden mit ihrer zugeordneten und vorhergehenden Zahl ausführen
  for a:=0 to 4 do
  begin
    //führendes Minus einrechnen, aber zuerst Punktrechnung "durchlassen"
    if (a = 3) and (ex[0].Operator = 3) then ex[0].Number:=-ex[0].Number;
    //Liste durchlaufen
    for b:=1 to index do
      //Eintrag mit entsprechendem Operator vorhanden?
      if ex[b].Operator = a then
        for c:=b-1 downto 0 do
          if ex[c].Operator < 255 then
          begin
            case a of
              0 : ex[c].Number:=Power(ex[c].Number,ex[b].Number);
              1 : ex[c].Number:=ex[c].Number/ex[b].Number;
              2 : ex[c].Number:=ex[c].Number*ex[b].Number;
              3 : ex[c].Number:=ex[c].Number-ex[b].Number;
              4 : ex[c].Number:=ex[c].Number+ex[b].Number;
            end;
            ex[b].Operator:=255;
            Break;
          end;
  end;
  Result:=ex[0].Number;
end;

end.