表达式计算器

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

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

//公式解析单元

 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; //堆栈;
   d1, d2: Double;
 begin
   Result := 0;
   stack := TStack.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