混合运算程序的代码

Question

如标题：求 四则混合运算程序的 代码（我只能看得懂Pascal的代码）我是个初学者，请大家帮帮忙吧。

Answer 1

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(1+1));
  ShowMessage(IntToStr(1-1));
  ShowMessage(IntToStr(1*1));
  ShowMessage(FloatToStr(1/1));
end;

Answer 2

//楼主应该要的是加减乘除的公式运算！我猜的！uses
  ComObj;
function TForm1.DoCaculate(exp: string): string;
var
  script: Variant;
begin
  script := CreateOleObject('ScriptControl');
  script.Language := 'JavaScript';
  Result := script.Eval(Exp);
end;procedure TForm1.btn1Click(Sender: TObject);
var
  str:string;
begin
   str:=DoCaculate('((1+2)*3)/3');
   ShowMessage(str);
end;

Answer 3

procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowMessage(FloatToStr(((1+2)*3)/3-1));
end;

Answer 4

unit BdsProc;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls;type
  TBdsProc = class
  Private
    Fghpd:Integer; //识别并标记左右括号是否成对出现
    function IsCalcFh(c:Char):boolean; //判别一个字符是否运算符
    function IsChar(c:char):Boolean;                        //判断是否字母
    function IsNotChar(c:string):Boolean;                   //判断是否有非法字符
    function CopyRight(abds:string; start:Integer):string;  //截取字符串表达式
    function BdsSs(var abds:string):Double; //返回一个子表达式的值
    //   function BdsHs(var abds: String): Double;   //函数内的计算
    function BdsYz(var abds:string):Double; //表达式因子，如：15、(13+5)
    function BdsItm(var abds:string):Double; //读取表达式中的一个因子  Public
    function GetCommaStrCount(sComma, str:string):Integer;
    function PublicExplain(sSource:string):string;          //接口
  end;  TPUSHPOP = class
  Private
    EndStep:Boolean;                                        //最后一步时 设为True
    ffh:array[0..2] of Char;                                //符号数组
    value:array[0..3] of Double;                            //值数组
    flevel:Byte;                                            //因子个数
    fisfh:Boolean; //识别等待输入值或运算符
    function Calcsj(av1, av2:Double; fh:Char):Double; //执行两个数值的四则运算
    procedure Calccur; //当输入数据项满足四个数后执行中间运算
    function IsCcFH(fh:Char):Boolean;                       // 判断运算符
  Public
    constructor Create;
    procedure PushValue(avalue:Double);                     //存入一个数据项
    procedure PushFh(afh:Char);                             //存入一个符号
    function CalcValue:Double;                              //计算并返回值
  end;implementation//uses Unit1;{ TBdsProc }function TBdsProc.BdsItm(var abds:string):Double;
var
  i, j, k, OldJ, iPoint, KHCount:integer;
  sCount       :real;
  IsInt        :boolean;
  sValue       :array[0..20] of string;
  sXiShu       :array[0..20] of real;
  s, c, HSName, HSIn:string;
  fArray       :array[1..20] of real;
  fMin, fMax, fAll:real;
begin
  //因子为函数时
  c := abds[1];
  if IsChar(Char(abds[1])) then
    begin
      k := 0;      HSName := Copy(abds, 1, 3);
      abds := Trim(copy(abds, 4, length(abds) - 3));
      if abds[1] <> '(' then
        raise Exception.Create('函数结构错误');
      Delete(abds, 1, 1);
      //      abds := copy(abds, 2, length(abds) - 1);
      while abds <> '' do
        begin
          c := abds[1];
          i := 1;
          KHCount := 0;
          while (c <> ',') or (KHCount>0) do
            begin
              if c = '(' then inc(KHCount);
              if c = ')' then dec(KHCount);
              if KHCount = -1 then Break; //在取函数中最后一个因子时,遇到函数的')'时退出本循环
              inc(i);
              c := copy(abds, i, 1);
            end;
          inc(k);
          HSIn := '(' + Copy(abds, 1, i - 1) + ')';
          //Form1.mmo1.Lines.Add('HSIn:'+HSIn);
          fArray[k] := BdsSs(HSIn); //```````````` 可扩展函数中嵌套函数
          abds := copy(abds, i + 1, length(abds) - i);
          if c <> ',' then break; //c为右括号的时候 退出该循环
        end;      fMin := fArray[1];
      fMax := fArray[1];
      fAll := 0;
      for i := 1 to k do
        begin
          if fArray[i] < fMin then fMin := fArray[i];
          if fArray[i] > fMax then fMax := fArray[i];
          fAll := fAll + fArray[i];
        end;
      if LowerCase(HSName) = LowerCase('Min') then
        Result := fMin
      else
        if LowerCase(HSName) = LowerCase('Max') then
        Result := fMax
      else
        if LowerCase(HSName) = LowerCase('Avg') then
        Result := StrToFloat(FormatFloat('#.0000', (fAll / k)))
      else
        raise Exception.Create('函数名错误');      //Form1.mmo1.Lines.Add('BdsItm:'+ FormatFloat('#.0000',Result));
      Exit;
    end;  //因子为数值时````````````````````````
  j := 0;
  IsInt := True;
  for i := 1 to Length(abds) do
    begin
      if ((abds[i] >= '0') and (abds[i] <= '9')) or (abds[i] = '.') then
        begin
          j := j + 1;
          if abds[i] = '.' then
            begin
              IsInt := False;
              iPoint := j;                                  //小数点所在位置
            end;          sValue[j] := copy(abds, i, 1);
        end
      else
        break;
    end;  OldJ := j;
  if IsInt then                                             //因子为整数
    begin
      k := 0;
      while j <> 0 do
        begin
          s := '1';
          for i := 1 to j - 1 do
            begin
              s := s + '0';
            end;
          K := k + 1;
          sXiShu[k] := StrToFloat(s);
          j := j - 1;
        end;
      j := OldJ;
      sCount := 0;
      for j := OldJ downto 1 do
        begin
          sCount := sXiShu[j] * strtoint(sValue[j]) + sCount;
        end;
      Result := sCount;
    end
  else
    begin
      j := OldJ;                                            //因子为浮点数
      while j <> 0 do
        begin
          if j > iPoint then
            begin
              s := '1';
              for i := 1 to (j - iPoint - 1) do
                begin
                  s := '0' + s;
                end;
              s := '0.' + s;
            end;
          //if j = iPoint then k := k+1;
          if j < iPoint then
            begin
              s := '1';
              for i := 1 to (iPoint - j - 1) do
                begin
                  s := s + '0';
                end;
            end;
          if j <> iPoint then sXiShu[j] := StrToFloat(s);
          j := j - 1;
        end;
      j := OldJ;
      sCount := 0;
      for j := OldJ downto 1 do
        begin
          if j = iPoint then Continue;
          sCount := sXiShu[j] * strtoint(sValue[j]) + sCount;
        end;
      Result := sCount;
    end;
  abds := Copy(abds, (OldJ + 1), (Length(abds) - OldJ));
end;

Answer 5

function TBdsProc.BdsSs(var abds:string):Double;
var
  c            :Char;
  lpp          :TPushPop;
begin
  lpp := TPushPop.Create;                                   //建立数据计算对象
  lpp.value[0] := 0;
  lpp.ffh[0] := '+';
  lpp.EndStep := False;
  //Form1.mmo1.Lines.Add('BdsSs:'+abds);
  while abds <> '' do
    begin
      c := abds[1];
      if IsCalcFh(c) then                                   //是否运算符
        begin
          lpp.PushFh(c);                                    //保存运算符
          Delete(abds, 1, 1);
          //abds := CopyRight(abds, 2);
        end
      else
        begin
          if c = ')' then
            begin
              Dec(Fghpd);                                   //括号匹配
              Delete(abds, 1, 1);
              //abds := CopyRight(abds, 2);
              if Fghpd < 0 then raise Exception.Create('括号不配对');
              Result := lpp.CalcValue; //返回括号中的子项值，进行下一步计算
              lpp.Free;
              Exit;
            end
          else
            begin
              if c = '(' then Inc(Fghpd);                   //做括号层数标识
              lpp.PushValue(BdsYz(abds));                   //取下一项的值。
            end;
        end;
    end;
  //  if Fghpd <> 0 then raise Exception.Create('括号不配对');  lpp.EndStep := True;
  lpp.Calccur;
  Result := lpp.Value[1];
  lpp.Free;
end;function TBdsProc.BdsYz(var abds:string):Double;
begin
  if abds <> '' then
    begin
      if abds[1] = '(' then
        begin
          //abds := CopyRight(abds, 2);
          Delete(abds, 1, 1);
          Result := BdsSs(abds); //递归调用，求括号中的值
        end
      else
        Result := BdsItm(abds);                             //读一个数据项
    end;
end;function TBdsProc.CopyRight(abds:string; start:Integer):string;
begin
  Result := Copy(abds, start, (length(abds) - 1));
end;function TBdsProc.GetCommaStrCount(sComma, str:string):Integer;
var
  s1, s2       :string;
  i            :Integer;
begin
  Result := 0;
  i := 0;
  if Trim(sComma) = '' then
    Exit;
  if Trim(str) = '' then
    str := ',';
  s1 := sComma + str;
  while pos(str, s1) <> 0 do
    begin
      s2 := copy(s1, 0, pos(str, s1));
      s1 := copy(s1, pos(str, s1) + 1, Length(s1));
      if Trim(s2) <> '' then
        Inc(i);
    end;
  Result := i;
end;//判别一个字符是否运算符function TBdsProc.IsCalcFh(c:Char):boolean;
begin
  if c in ['+', '-', '*', '/'] then
    Result := True
  else
    Result := False;
end;
//判断是否字母function TBdsProc.IsChar(c:char):Boolean;
begin
  if ((c >= 'a') and (c <= 'z')) or ((c >= 'A') and (c <= 'Z')) then
    Result := True
  else
    Result := False;
end;
//判断是否有非法字符function TBdsProc.IsNotChar(c:string):Boolean;
var
  sound_code   :set of char;
  compare      :set of char;
  i            :Integer;
begin
  sound_code := ['0'..'9', 'a'..'z', 'A'..'Z', '+', '-', '*', '/', '(', ')',
    ',', '.', ' '];
  compare := ['1'];
  for i := 1 to Length(c) do
    begin
      Include(compare, Char(c[i]));
    end;  if sound_code = sound_code + compare then
    Result := True
  else
    Result := False;
end;
//接口function TBdsProc.PublicExplain(sSource:string):string;
var
  TestClass    :TBdsProc;
  i, x         :Integer;
begin
  if not IsNotChar(sSource) then
    raise Exception.Create('有非法字符');
  if GetCommaStrCount(sSource, '(') <> GetCommaStrCount(sSource, ')') then
    raise Exception.Create('括号不配对');
  TestClass := TBdsProc.Create;
  //Form1.mmo1.Lines.Add('计算:'+sSource);
  Result := FloatToStr(TestClass.BdsSs(sSource));
  //Form1.mmo1.Lines.Add('结果:'+Result);
  TestClass.Free;
end;{ TPUSHPOP }procedure TPUSHPOP.Calccur;
begin
  if IsCcFh(ffh[1]) then                                    //二级运算符
    begin
      value[1] := Calcsj(value[1], value[2], ffh[1]);       //计算2和3项的值
      ffh[1] := ffh[2];                                     //后序运符和值前移
      value[2] := value[3];
    end
  else                                                      //一级运算符
    begin
      value[0] := Calcsj(value[0], value[1], ffh[0]);       //计算1和2项的值
      value[1] := value[2];
      value[2] := value[3];
      ffh[0] := ffh[1];
      ffh[1] := ffh[2];
    end;
  Dec(flevel);                                              //存数位置指针减1
  if EndStep then
    begin
      Value[1] := Calcsj(value[0], value[1], ffh[0]);
    end;
end;
//执行两个数值的四则运算function TPUSHPOP.Calcsj(av1, av2:Double; fh:Char):Double;
begin
  if fh = '+' then result := av1 + av2;
  if fh = '-' then result := av1 - av2;
  if fh = '*' then result := av1 * av2;
  if fh = '/' then
    begin
      if av2 = 0 then
        begin
          raise Exception.Create('除数不能为0');
          Exit;
        end
      else
        result := StrToFloat(FormatFloat('#.0000', (av1 / av2)));
    end;
//  Form1.mmo1.Lines.Add('Calcsj:'+FormatFloat('#.0000',av1)+fh+FormatFloat('#.0000',av2));
end;function TPUSHPOP.CalcValue:Double;
begin
  if ffh[1] = '' then
    begin
      result := Calcsj(value[0], value[1], ffh[0]);
      exit;
    end;
  if IsCcFh(ffh[1]) then                                    //二级运算符
    begin
      value[1] := Calcsj(value[1], value[2], ffh[1]);       //计算2和3项的值
      result := Calcsj(value[0], value[1], ffh[0]);
    end
  else
    begin
      value[1] := Calcsj(value[0], value[1], ffh[0]);
      result := Calcsj(value[1], value[2], ffh[1]);
    end;
end;constructor TPUSHPOP.Create;
begin
  inherited create;
end;function TPUSHPOP.IsCcFH(fh:Char):Boolean;
begin
  if (fh = '*') or (fh = '/') then
    Result := True
  else
    Result := False;
end;procedure TPUSHPOP.PushFh(afh:Char);
begin
  ffh[flevel] := afh;                                       //存入运算符
  fisfh := False;                                           // 输入值可见
end;procedure TPUSHPOP.PushValue(avalue:Double);
begin
  if fisfh = True then raise Exception.Create('缺少运算符');  inc(flevel);                                              //存数位置指针加1
  value[flevel] := avalue;                                  //存入值
  if flevel > 2 then Calccur; //数据个数达到4，进行中间运算  fisfh := True;                                            //输入符号可见
end;end. 

Answer 6

最后通过
function PublicExplain(sSource:string):string; 
用哈.

Answer 7

随手写的，只处理四则运算，可能不太容易看懂
如果想处理带括号的话，比较经典的算法是“逆波兰表达式”，有兴趣的话可以看看我以前的文章：
egust.spaces.live.com/blog/cns!98563909D0913C04!218.entryunit Unit2;interfaceuses
  Classes, SysUtils;type
  TTokenType  = (ttNone, ttNumber, ttOperator, ttSpace, ttError, ttEnd);
  TOperatorType = (otAdd, otSub, otMul, otDiv);
  TDataRec  = record
  case Kind: TTokenType of
    ttNumber    : ( Number: Single );
    ttOperator  : ( Operator: TOperatorType );
  end;
  PDataRec  = ^TDataRec;  TSimpleCalc = class
  private
    FToken  : TDataRec;
    FExpression, FEnd, FRun : PAnsiChar;
    FDatas  : TList;
  protected
    function DoParse: Boolean;
    function DoCalc: Single;
    procedure ClearData;
  public
    constructor Create;
    destructor Destroy; override;
    function Calculate(const Expression: string; out Ret: Single): Boolean;
  end;  function Calculate(const Expression: string; out Ret: Single): Boolean;implementationfunction Calculate(const Expression: string; out Ret: Single): Boolean;
begin
  with TSimpleCalc.Create do
  try
    Result  := Calculate(Expression, Ret);
  finally
    Free;
  end;
end;  type
  TprocParser  = procedure(var Run: PAnsiChar; out Data: TDataRec);
  TfuncCalc = function(Val1, Val2: Single): Single;function Calc_Add(Val1, Val2: Single): Single;
begin
  Result  := Val1 + Val2;
end;function Calc_Sub(Val1, Val2: Single): Single;
begin
  Result  := Val1 - Val2;
end;function Calc_Mul(Val1, Val2: Single): Single;
begin
  Result  := Val1 * Val2;
end;function Calc_Div(Val1, Val2: Single): Single;
begin
  Result  := Val1 / Val2;
end;const
  ffunCalcs : array[TOperatorType]of function(Val1, Val2: Single): Single =
  ( Calc_Add, Calc_Sub, Calc_Mul, Calc_Div );var
  procParsers : array[AnsiChar]of TprocParser;
  MappedPP  : Boolean;procedure ParserDefault(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind := ttError;
end;procedure ParserWhiteSpace(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind := ttSpace;
  while(Run^in[#9, #10, #13, #32])do Inc(Run);
end;procedure ParserEOF(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind := ttEnd;
end;procedure ParserOpt_Add(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind     := ttOperator;
  Data.Operator := otAdd;
  Inc(Run);
end;procedure ParserOpt_Sub(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind     := ttOperator;
  Data.Operator := otSub;
  Inc(Run);
end;procedure ParserOpt_Mul(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind     := ttOperator;
  Data.Operator := otMul;
  Inc(Run);
end;procedure ParserOpt_Div(var Run: PAnsiChar; out Data: TDataRec);
begin
  Data.Kind     := ttOperator;
  Data.Operator := otDiv;
  Inc(Run);
end;const
  NumberSet = ['0'..'9'];procedure ParserDot(var Run: PAnsiChar; out Data: TDataRec);
var
  pLast : PAnsiChar;
  sToken  : string;
begin
  pLast := Run;
  Inc(Run);
  if(not(Run^in NumberSet))then
  begin
    Data.Kind := ttNone;
    Exit;
  end;
  repeat
    Inc(Run);
  until not(Run^ in NumberSet);
  SetString(sToken, pLast, Run - pLast);
  Data.Kind   := ttNumber;
  Data.Number := StrToFloat(sToken);
end;procedure ParserN(var Run: PAnsiChar; out Data: TDataRec);
var
  pLast : PAnsiChar;
  sToken  : string;
begin
  pLast := Run;
  repeat
    Inc(Run);
  until not(Run^in['0'..'9']);
  if(Run^='.')then
  repeat
    Inc(Run);
  until not(Run^ in NumberSet);
  SetString(sToken, pLast, Run - pLast);
  Data.Kind   := ttNumber;
  Data.Number := StrToFloat(sToken);
end;{ TSimpleCalc }function TSimpleCalc.Calculate(const Expression: string;
  out Ret: Single): Boolean;
begin
  ClearData;
  FExpression := Pointer(Expression);
  FEnd  := FExpression + Length(Expression);
  FRun  := FExpression;
  FillChar(FToken, SizeOf(FToken), 0);
  try
    Result  := (FEnd>FRun)and DoParse;
    if(Result)then
      Ret   := DoCalc;
  except
    on E: Exception do
    begin
      Result  := False;
      E.Free;
    end;
  end;
end;procedure TSimpleCalc.ClearData;
var
  i : Integer;
begin
  with FDatas do
  for i:=Count-1 downto 0 do
    Dispose(PDataRec(Items[i]));
  FDatas.Clear;
end;constructor TSimpleCalc.Create;
var
  c : AnsiChar;
begin
  if(not MappedPP)then
  begin
    for c:=Low(c)to High(c)do
      procParsers[c]  := ParserDefault;
    for c:='0' to '9' do
      procParsers[c]  := ParserN;
    procParsers['.']  := ParserDot;
    procParsers['+']  := ParserOpt_Add;
    procParsers['-']  := ParserOpt_Sub;
    procParsers['*']  := ParserOpt_Mul;
    procParsers['/']  := ParserOpt_Div;
    procParsers[#0]   := ParserWhiteSpace;
    procParsers[#9]   := ParserWhiteSpace;
    procParsers[#10]  := ParserWhiteSpace;
    procParsers[#13]  := ParserWhiteSpace;
    procParsers[#32]  := ParserWhiteSpace;
    MappedPP  := True;
  end;
  FDatas  := TList.Create;
end;destructor TSimpleCalc.Destroy;
begin
  ClearData;
  FDatas.Free;
  inherited;
end;function TSimpleCalc.DoCalc: Single;
var
  i, it : Integer;
  opt : TOperatorType;
begin
  // step 1: * and /
  i := 0;
  while(i<(FDatas.Count shr 1))do
  begin
    it  := i shl 1;
    opt := PDataRec(FDatas[it + 1]).Operator;
    if(opt in[otAdd, otSub])then
    begin
      Inc(i);
      Continue;
    end;    with PDataRec(FDatas[it])^do
    Number  := ffunCalcs[opt](Number, PDataRec(FDatas[it + 2]).Number);
    Dispose(PDataRec(FDatas[it + 1]));
    Dispose(PDataRec(FDatas[it + 2]));
    FDatas.Delete(it+1);
    FDatas.Delete(it+1);
  end;  // step 2: + and -
  while(FDatas.Count>1)do
  begin
    with PDataRec(FDatas[0])^do
    Number  := ffunCalcs[PDataRec(FDatas[1]).Operator]
        (Number, PDataRec(FDatas[2]).Number);
    Dispose(PDataRec(FDatas[1]));
    Dispose(PDataRec(FDatas[2]));
    FDatas.Delete(1);
    FDatas.Delete(1);
  end;
  Result  := PDataRec(FDatas[0]).Number;
end;function TSimpleCalc.DoParse: Boolean;
var
  pData   : PDataRec;
  tkLast  : TTokenType;
begin
  pData := nil;
  repeat
    tkLast  := FToken.Kind;
    procParsers[FRun^](FRun, FToken);
    with FToken do
    case Kind of
      ttNone, ttError, ttEnd  :
        Break;
      ttNumber, ttOperator  :
      begin
        if( ((tkLast=ttNone)and(Kind=ttOperator))or
            ((tkLast<>ttNone)and(tkLast=Kind)) )then
          Break;
        New(pData);
        pData^  := FToken;
        FDatas.Add(pData);
      end;  
    end;
  until(FRun>=FEnd);
  Result  := Boolean(FDatas.Count and 1) and (pData.Kind=ttNumber);
end;end.

Answer 8

表达式计算器的核心代码
http://blog.csdn.net/stgsd/archive/2008/11/21/3346002.aspx

Answer 9

我的
type 
  TBdsProc = class 
  Private 
    Fghpd:Integer; //识别并标记左右括号是否成对出现 
    function IsCalcFh(c:Char):boolean; //判别一个字符是否运算符 
    function IsChar(c:char):Boolean;                        //判断是否字母 
    function IsNotChar(c:string):Boolean;                  //判断是否有非法字符 
    function CopyRight(abds:string; start:Integer):string;  //截取字符串表达式 
    function BdsSs(var abds:string):Double; //返回一个子表达式的值 
    //  function BdsHs(var abds: String): Double;  //函数内的计算 
    function BdsYz(var abds:string):Double; //表达式因子，如：15、(13+5) 
    function BdsItm(var abds:string):Double; //读取表达式中的一个因子   Public 
    function GetCommaStrCount(sComma, str:string):Integer; 
    function PublicExplain(sSource:string):string;          //接口 
  end; 发生编译错误
为什么 我的function声明无法加入Private和Public下。