unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function InStr(p: Integer; s, ts: string): LongInt;
var i: Integer;

begin
  i:=Pos(ts, Copy(s, p, Length(s)-p+1));

  if i>0 then
    result:=p-1+i
  else
    result:=0;
end;

function DownInStr(p: Integer; s, ts: string): LongInt;
var i, j: Integer;

begin
  i:=0; j:=InStr(i+1, s, ts);

  while (j>0) and (j<=p) do
  begin
    i:=j;
    j:=InStr(i+1, s, ts);
  end;

  result:=i;
end;

//

function CalcTerm(Term: string): Extended;
var i, inp, outp: Integer;
    e: Extended;
    s, p: string;
    c: Char;

begin
  result:=0; e:=0; s:=Term; c:='+'; inp:=0;

  for i:=1 to Length(s) do
    if (s[i] in ['+', '-', '*', '/']) or (i=Length(s)) then
    begin
      if not (s[i] in ['+', '-', '*', '/']) then
        outp:=i+1
      else
        outp:=i;

      p:=Copy(s, inp+1, (outp-1)-inp);

      if p<>'' then
      begin
        case c of
          '+': e:=e+strtofloat(p);
          '-': e:=e-strtofloat(p);
          '*': e:=e*strtofloat(p);
          '/': e:=e/strtofloat(p);
        end;

        if not (s[i] in ['+', '-', '*', '/']) or (s[i] in ['+', '-']) then
        begin
          result:=result+e;
          e:=0;
        end;

        c:=s[i]; inp:=i;
      end
      else //für *-, /- c und inp bleiben erhalten (c=* oder c=/), - gehört dann zum p, wg. --5 z.B.
      begin
        if ((c='-') and (s[i]='-')) or ((c='+') and (s[i]='+')) then //--, ++
        begin
          c:='+'; inp:=i;
        end
        else
          if ((c='-') and (s[i]='+')) or ((c='+') and (s[i]='-')) then //-+, +-
          begin
            c:='-'; inp:=i;
          end;
      end;
    end;
end;

function Calc(Term: string): Extended;
var i, j: Integer;
    s, p: string;

begin
  result:=0;

  s:=Term;

  i:=Pos(')', s);

  while i>0 do
  begin
    j:=DownInStr(i, s, '(');

    if j>0 then
    begin
      p:=Copy(s, j+1, (i-1)-j);
      Delete(s, j, i-(j-1));

      p:=floattostr(CalcTerm(p));
      Insert(p, s, j);
    end
    else
      Exit;

    i:=Pos(')', s);
  end;

  result:=CalcTerm(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption:=floattostr(Calc(Edit1.Text));
end;

end.


object Form1: TForm1
  Left = 225
  Top = 104
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Calc'
  ClientHeight = 62
  ClientWidth = 337
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  TextHeight = 13
  object Edit1: TEdit
    Left = 8
    Top = 8
    Width = 321
    Height = 21
    TabOrder = 0
    Text = '34+3*(25-2*(3+6-(12-3)*0,5)+36/(12-3*3))'
  end
  object Button1: TButton
    Left = 8
    Top = 32
    Width = 321
    Height = 25
    Caption = 'Rechnen'
    TabOrder = 1
    OnClick = Button1Click
  end
end

Zurück