// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

unit ExpParse;

interface

uses Classes;

{ Набор парсируемых элементов определяется как подмножество
выражений Delphi Object Pascal, подобно этому:

Expr   ::= Term + Expr | Term - Expr | Term
Term   ::= Factor * Term | Factor / Term | Factor
Factor ::= + Item | - Item | Item
Item   ::= ( Expr ) | Fn( Expr ) | Number
Fn     ::= Sin | Cos | другое...
Number ::= floating point literal number (плавающая точка литерала числа)
}

type
  TExpressionParser = class(TParser)
  protected
    function SkipToken(Value: char): boolean;
    function EvalItem: double; virtual;
    function EvalFactor: double; virtual;
    function EvalTerm: double; virtual;
  public
    function EvalExpr: double;
  end;

implementation

uses SysUtils;

function TExpressionParser.SkipToken(Value: char): boolean;
begin
  { возвращаем истину, если текущий признак Value,
  и если так, то получаем следующий признак }
  Result := Token = Value;
  if Result then
    NextToken;
end;

function TExpressionParser.EvalItem: double;

var
  Expr: double;
  Fn: integer;

begin
  case Token of
    toInteger: Result := TokenInt;
    toFloat: Result := TokenFloat;
    '(':
      begin
        NextToken;
        Result := EvalExpr;
        CheckToken(')');
      end;
    toSymbol:
      begin
        if CompareText(TokenString, 'SIN') = 0 then
          Fn := 1
        else if CompareText(TokenString, 'COS') = 0 then
          Fn := 2
        else
          raise EParserError.CreateFmt('Неизвестный элемент "%s"', [TokenString]
            );

        NextToken;
        CheckToken('(');
        NextToken;
        Expr := EvalExpr;
        CheckToken(')');
        case Fn of
          1: Result := SIN(Expr);
          2: Result := COS(Expr);
        end;
      end;
  else
    raise EParserError.CreateFmt('Неожидаемый символ "%s"', [Token]);
  end;
  NextToken;
end;

function TExpressionParser.EvalFactor: double;

begin
  case Token of
    '+':
      begin
        NextToken;
        Result := EvalItem;
      end;
    '-':
      begin
        NextToken;
        Result := -EvalItem;
      end;
  else
    Result := EvalItem;
  end;
end;

function TExpressionParser.EvalTerm: double;
var
  AToken: char;
begin
  Result := EvalFactor;
  if SkipToken('*') then
    Result := Result * EvalTerm
  else if SkipToken('/') then
    Result := Result / EvalTerm;
end;

function TExpressionParser.EvalExpr: double;
begin
  Result := EvalTerm;
  if SkipToken('+') then
    Result := Result + EvalExpr
  else if SkipToken('-') then
    Result := Result - EvalExpr;
end;

end.

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

unit EvalForm;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExpParse;

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

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
  MemStream: TMemoryStream;
  ExpressionParser: TExpressionParser;
begin
  { get the string to evaluate }
  s := Edit1.Text;

  { создаем поток для работы с памятью, содержащий текст -
  TParser может разбирать выражения из потока}

  MemStream := TMemoryStream.Create;
  try
    MemStream.SetSize(Length(s));
    MemStream.WriteBuffer(s[1], Length(s));
    MemStream.Position := 0;

    { создаем анализатор выражения, используя поток }
    ExpressionParser := TExpressionParser.Create(MemStream);
    try
      Label2.Caption := Format('Результат=%g', [ExpressionParser.EvalExpr]
        );

    finally
      ExpressionParser.Free;
    end;
  finally
    MemStream.Free;
  end;
end;
end.

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

object Form1: TForm1
  Left = 216
    Top = 102
    Width = 433
    Height = 300
    Caption = 'Form1'
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = []
    PixelsPerInch = 96
    TextHeight = 16
    object Label1: TLabel
    Left = 8
      Top = 8
      Width = 74
      Height = 16
      Caption = 'Выражение'
  end
  object Label2: TLabel
    Left = 120
      Top = 72
      Width = 297
      Height = 16
      AutoSize = False
      Caption = 'Результат='
  end
  object Edit1: TEdit
    Left = 8
      Top = 27
      Width = 409
      Height = 24
      TabOrder = 0
      Text = '(23.34 + 21.21) * 2.92 - 12.21 * sin (180) * -1'
  end
  object Button1: TButton
    Left = 8
      Top = 64
      Width = 89
      Height = 33
      Caption = 'Оценка'
      default = True
      TabOrder = 1
      OnClick = Button1Click
  end
end