表达式计算器

来源：互联网发布：网络金融互助平台编辑：程序博客网时间：2024/04/29 01:30

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

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

//公式解析单元

[delphi] view plaincopy
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.  

//调用单元

[delphi] view plaincopy
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.  

//调用单元窗体代码

[delphi] view plaincopy
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  

0 0