表达式计算器

表达式计算器, 支持四则混合运算, 常量代入

扩展后可实现表达式嵌套引用, 防循环调用等功能

//公式解析单元

unit utFormula;

interface
  uses SysUtils, Generics.Collections;
type
  //表达式计算器
  TFormula = class
  private const
    OPE = ['+', '-', '*', '/', '(', ')']; //允许出现的运算符
    OPEFORCALC = ['+', '-', '*', '/'];    //参与最终计算的运算符

  private
    ConstValue : TDictionary<string, Double>;  //待替换的常量表
  private
    // 判断是否是操作数
    function IsOperand(ch: Char): boolean;
    // 返回运算符的优先级
    function Priority(ch: Char): integer;
    // 对两个值利用运算符计算结果
    function GetValue(op: Char; const val1, val2: Double): Double;
    // 判断是否数字
    function isNumber(const s: string): boolean;
    // 根据原生公式串生成公式分项列表(后缀表达式), 公式操作数列表
    procedure splitExp(FExp : TList<string>; const sValue: string);
    //依据后缀表达式计算结果
    function CalcItem(FExp : TList<string>): Double;
    //将字符串转为有效双精度值
    function CustomStrToDouble(const Key: string): Double;
  public
    constructor Create;
    destructor Destroy; override;
    //计算表达式
    function Calc(const AFormulaStr : string) : Double;
  end;
implementation

{ TFormula }
function TFormula.CustomStrToDouble(const Key : string): Double;
begin
  Result := 0;

  if isNumber(Key) then   //如果是数值, 直接返回
    Result := StrToFloat(Key)
  else
  if not ConstValue.TryGetValue(Key, Result) then  //如果是常量则返回, 否则报出异常
    raise Exception.Create('无法识别的数值!');
end;

function TFormula.CalcItem(FExp : TList<string>): Double;
var
  i: integer;
  val: string;
  stack: TStack<Double>; //堆栈;
  d1, d2: Double;
begin
  Result := 0;
  stack := TStack<Double>.create;  //创建栈对象
  try
    if FExp.Count = 1 then  //只有一个数据项时, 直接转换结果
    begin
      Result := CustomStrToDouble(FExp.Items[0]);
    end
    else
    begin
      for i := 0 to FExp.Count - 1 do   //逐项计算
      begin
        val := FExp.Items[i];
        if (Length(val) = 1) and (val[1] in OPEFORCALC) then  //是运算符则计算, 反之压栈
        begin
          d2 := stack.Pop;
          d1 := stack.Pop;
          Result := GetValue(val[1], d1, d2); //根据运算符和数据项计算结果
          stack.push(Result);   //计算结果压栈
        end
        else
          stack.push(CustomStrToDouble(val));
      end;
    end;
  finally
    stack.Free;
  end;
end;
function TFormula.Calc(const AFormulaStr: string): Double;
var
  FExp : TList<string>; // 公式分项列表, 后缀表达式  用于表达式计算
begin
  result := 0;
  if sametext(AFormulaStr, '') then
    raise Exception.Create('无效的表达式');

  FExp := TList<string>.Create;
  try
    try
      splitExp(FExp , AFormulaStr); //产生后缀表达式
      result := CalcItem(FExp);  //计算后缀表达式

    except on E: Exception do
      raise Exception.Create(e.Message);
    end;
  finally
    FExp.Free;
  end;
end;

constructor TFormula.Create;
begin
  //创建常量表, 并初始化
  ConstValue := TDictionary<string, Double>.Create;
  ConstValue.Add('∏', 3.1415926);
end;

destructor TFormula.Destroy;
begin
  ConstValue.Free;  //销毁常量表
  inherited;
end;

function TFormula.GetValue(op: Char; const val1, val2: Double): Double;
begin
  case op of
    '+':
      Result := val1 + val2;
    '-':
      Result := val1 - val2;
    '*':
      Result := val1 * val2;
    '/':
      begin
        if val2 = 0 then
          Result := 0
        else
          Result := val1 / val2;
      end;
  end;
end;

function TFormula.isNumber(const s: string): boolean;
var
  i: Extended;
  Code: integer;
begin
  val(s, i, Code);
  Result := Code = 0;
end;

function TFormula.IsOperand(ch: Char): boolean;
begin
  Result := not(ch in OPE);
end;

function TFormula.Priority(ch: Char): integer;
begin
  case ch of
    '+':
      Result := 1;
    '-':
      Result := 1;
    '*':
      Result := 2;
    '/':
      Result := 2;
  else
    Result := 0;
  end;
end;

procedure TFormula.splitExp(FExp : TList<string>; const sValue: string);
  function AddToExp(const Value : string): string;
  begin
    Result := '';
    if Value = '' then Exit;

    FExp.Add(Value);
  end;
var
  ch, ch1: Char;
  stack: TStack<char>; // 堆栈;
  i: integer;
  sOperand: string;

begin
  // 利用集合模拟堆栈操作,产生后缀表达式

  stack := TStack<char>.create;
  try
    sOperand := '';
    for i := 1 to Length(sValue) do
    begin
      if sValue[i] = chr(32) then
        Continue; // 去除多余的空字符

      ch := sValue[i];
      if IsOperand(ch) then // 如果是操作数，直接放入B中
      begin
        sOperand := sOperand + ch;
      end
      else
      begin
        sOperand := AddToExp(sOperand);
        if ch = '(' then // 如果是'('，将它放入堆栈中
        begin
          stack.Push(ch);
        end
        else if ch = ')' then // 如果是')'
        begin
          while stack.Count > 0 do // 不停地弹出堆栈中的内容，直到遇到'('
          begin
            ch := stack.Pop;
            if ch = '(' then
              break
            else
            begin
              FExp.Add(ch);
            end;
          end;
        end
        else // 既不是'('，也不是')'，是其它操作符，比如+, -, *, /之类的
        begin
          if stack.Count > 0 then
          begin
            while stack.Count > 0 do
            begin
              ch1 := stack.Pop; // 弹出栈顶元素
              if Priority(ch) > Priority(ch1) then // 如果栈顶元素的优先级小于读取到的操作符
              begin
                stack.push(ch1); // 将栈顶元素放回堆栈
                stack.push(ch); // 将读取到的操作符放回堆栈
                break;
              end
              else // 如果栈顶元素的优先级比较高或者两者相等时
              begin
                FExp.Add(ch1);
                if stack.Count = 0 then
                begin
                  stack.push(ch); // 将读取到的操作符压入堆栈中
                  break;
                end;
              end;
            end;
          end
          else
            stack.push(ch); // 如果堆栈为空，就把操作符放入堆栈中
        end;
      end;
    end;
    AddToExp(sOperand);

    while stack.Count > 0 do
      AddToExp(stack.Pop);

  finally
    stack.Free;
  end;
end;
end.

//调用单元

unit utForm;

interface

uses
  SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Buttons, ToolWin;

type
  TFrmMain = class(TForm)
    grp1: TGroupBox;
    grp2: TGroupBox;
    mmoFormula: TMemo;
    mmoValue: TMemo;
    tlb1: TToolBar;
    btnCalc: TSpeedButton;
    procedure btnCalcClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FrmMain: TFrmMain;

implementation
uses utFormula;

{$R *.dfm}
procedure TFrmMain.btnCalcClick(Sender: TObject);
var
  AFormula : TFormula;
  i : integer;
  Value : Double;
begin
  mmoValue.Clear;
  AFormula := TFormula.Create;
  try
    for i := 0 to mmoFormula.Lines.Count - 1 do
    begin
      try
        //表达式计算
        Value := AFormula.Calc(mmoFormula.Lines.Strings[i]);
        //打印结果
        mmoValue.Lines.Add(mmoFormula.Lines.Strings[i] + '=' + FloatToStr(Value));
      except
        on E: Exception do  //异常处理
        begin
          ShowMessage(e.Message);
          mmoValue.Lines.Add(mmoFormula.Lines.Strings[i] + '=?????????');
        end;
      end;
    end;
  finally
    AFormula.Free;
  end;
end;



end.

//调用单元窗体代码

object FrmMain: TFrmMain
  Left = 0
  Top = 0
  Caption = #34920#36798#24335#35745#31639
  ClientHeight = 479
  ClientWidth = 735
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object grp1: TGroupBox
    Left = 0
    Top = 29
    Width = 392
    Height = 450
    Align = alLeft
    Caption = #34920#36798#24335
    TabOrder = 0
    object mmoFormula: TMemo
      Left = 2
      Top = 15
      Width = 388
      Height = 433
      Align = alClient
      Lines.Strings = (
        '1+2'
        '2*2'
        '(1+2*3-3)/2'
        #8719'+1')
      TabOrder = 0
      ExplicitLeft = 45
      ExplicitWidth = 341
    end
  end
  object grp2: TGroupBox
    Left = 392
    Top = 29
    Width = 343
    Height = 450
    Align = alClient
    Caption = #35745#31639#32467#26524
    TabOrder = 1
    ExplicitTop = 0
    ExplicitWidth = 249
    ExplicitHeight = 479
    object mmoValue: TMemo
      Left = 2
      Top = 15
      Width = 339
      Height = 433
      Align = alClient
      TabOrder = 0
      ExplicitTop = 72
      ExplicitWidth = 181
      ExplicitHeight = 405
    end
  end
  object tlb1: TToolBar
    Left = 0
    Top = 0
    Width = 735
    Height = 29
    ButtonHeight = 26
    ButtonWidth = 121
    Caption = 'tlb1'
    TabOrder = 2
    ExplicitLeft = 376
    ExplicitWidth = 150
    object btnCalc: TSpeedButton
      Left = 0
      Top = 0
      Width = 128
      Height = 26
      BiDiMode = bdLeftToRight
      Caption = #24320#22987#35745#31639
      ParentBiDiMode = False
      OnClick = btnCalcClick
    end
  end
end