unit1.pas

用delphi编写的小程序

   Balancer : TBalancer;
   i : Integer;
Begin
   Try
      Balancer := TBalancer.Create; //生成配平类
      Balancer.MyInitialization; //进行初始化
      Balancer.Work; //进行配平

      For i := 0 To Balancer.ReactorsCou - 1 Do Begin //显示配平结果
         If Balancer.Actors[i].Num = 0 Then
            Raise Exception.Create('');
         Memo2.Lines.Add(Inttostr(Balancer.Actors[i].Num)); //显示系数
         Memo3.Lines.Add(FloatToStr(Balancer.Actors[i].Num * Balancer.Actors[i].Mass)); //显示式量
      End;
      For i := Balancer.ReactorsCou To Balancer.AllCou - 1 Do Begin
         If Balancer.Actors[i].Num = 0 Then
            Raise Exception.Create('');
         Memo4.Lines.Add(Inttostr(Balancer.Actors[i].Num)); //显示系数
         Memo5.Lines.Add(FloatToStr(Balancer.Actors[i].Num * Balancer.Actors[i].Mass)); //显示式量
      End;
      BtnBalance.Enabled := False;
      AddToReactor.Enabled := False;
      DeleteIt1.Enabled := False;
      AddToOut.Enabled := False;
      DeleteIt2.Enabled := False;
   Except //发生错误
      On E : Exception Do
         MessageDlg(ErrInfo, mtError, [mbOK], 0);
   End;
End;


///////////函数库//////////////////////////////////////////////////////////////
Function GetMassOfElement(ElementName : String) : Single; //获取元素的相对原子质量
Var
   i : Integer;
Begin
   i := Elements.IndexOf(ElementName);
   //showmessage(ElementName) ;
   //If i = -1 Then Raise Exception.Create(''); //未发现此元素，触发错误,让TFormMain.Button2Click过程捕捉
   Result := MOfElements[i + 1];
End;
////

Function GetMassOfFormula(Exp : String; WorkState : Byte = 1) : String; //可以计算任意化学式的式量(WorkState=1),当被RebuildReactors调用时进行元素出现次数的统计(WorkState=2)
Var
   MultiplyBy, BracketLP, BracketRP : Integer; //BracketLP为左括号的位置,BracketRP为右括号的位置
   delLen : Integer; //存储 删除 Exp 多少个字符
   MAll : Single; //存储 最终的式量

   Function StrToNum(S : String) : Integer; //字符串转为系数，如为空串,系数为1
   Begin
      If S = '' Then
         Result := 1
      Else
         Result := StrToInt(S);
   End;

   Function NumToNumLength(i : Integer) : Integer; //系数字符串的长度
   Begin
      If i = 1 Then //系数为1，系数字符串为空
         Result := 0
      Else
         Result := Length(Inttostr(i)); //系数不为1，系数字符串不为空
   End;

   Function MultiplyByWhat(BeginAt : Integer; E : String) : Integer; //计算Cu(OH)2 , O3 中的2,3,即元素系数
   Var
      i, l : Integer;
   Begin
      E := E + ' ';
      l := Length(E);
      For i := BeginAt + 1 To l Do
         If (E[i] In NumberSet = False) Then Begin
            Result := StrToNum(Copy(E, BeginAt + 1, i - BeginAt - 1));
            Exit;
         End;
   End;

   Function CaclEWithOutBracket(Ex : String) : Single; //计算不含"()"的式子的式量
   Var
      MydelLen, MyMultiplyBy, k : Integer; //MydelLen为删除 Ex 多少个字符,MyMultiplyBy为某个元素的个数
      M : Single;
      Chr2 : Char;
      Element : String;
   Begin
      Result := 0;
      Repeat
         If Length(Ex) > 1 Then
            Chr2 := Ex[2]
         Else
            Chr2 := 'E'; //表明Chr2不在LowAlpha中,任何大写字母都可
         If (Chr2 In LowAlpha) Then Begin //如果化学元素符号为两个字母
            Element := Copy(Ex, 1, 2);
            M := GetMassOfElement(Element); //获得元素相对原子质量,元素为两个字母，所以取Ex的前两个字符
            MyMultiplyBy := MultiplyByWhat(2, Ex);

            If WorkState = 2 Then Begin //进行元素个数的统计
               k := AllElements.IndexOf(Element);
               ReactorOrOutPut^.EachElementCou[k] := ReactorOrOutPut^.EachElementCou[k] + MyMultiplyBy * MultiplyBy;
            End;

            MydelLen := 2 + NumToNumLength(MyMultiplyBy);
         End Else Begin //如果化学元素符号为一个字母
            Element := Copy(Ex, 1, 1);
            M := GetMassOfElement(Element); //获得元素相对原子质量,元素为一个字母，所以取Ex的前一个字符
            MyMultiplyBy := MultiplyByWhat(1, Ex);

            If WorkState = 2 Then Begin //进行元素个数的统计
               k := AllElements.IndexOf(Element);
               ReactorOrOutPut^.EachElementCou[k] := ReactorOrOutPut^.EachElementCou[k] + MyMultiplyBy * MultiplyBy;
            End;

            MydelLen := 1 + NumToNumLength(MyMultiplyBy);
         End;
         Result := Result + M * MyMultiplyBy;
         Delete(Ex, 1, MydelLen);
      Until Ex = '';
   End;
Begin
   MAll := 0;
   Repeat
      MultiplyBy := 1;
      If Exp[1] <> '(' Then Begin //如果exp不以"("开头
         BracketLP := pos('(', Exp);
         If BracketLP = 0 Then Begin //如果式子中无"("
            MAll := MAll + CaclEWithOutBracket(Exp); //由于无括号了，所以计算全部
            delLen := Length(Exp); //删除长度为整个Exp,即删除全部，跳出循环,结束计算
         End Else Begin
            delLen := BracketLP - 1;
            MAll := MAll + CaclEWithOutBracket(Copy(Exp, 1, delLen)); //计算括号中的式量
         End;
      End Else Begin //如果exp以"("开头 ,寻找")",计算"()"中的式子的式量并乘以括号外的系数
         BracketRP := pos(')', Exp);
         MultiplyBy := MultiplyByWhat(BracketRP, Exp); //获得括号后的系数,即Cu(OH)2 中的2
         MAll := MAll + MultiplyBy * CaclEWithOutBracket(Copy(Exp, 2, BracketRP - 2)); //计算括号中的式量，并乘以括号后的系数(MultiplyBy)
         delLen := BracketRP + NumToNumLength(MultiplyBy);
      End;
      Delete(Exp, 1, delLen);
   Until Exp = ''; //计算完一个部分，删除一个部分, 直到 exp 中的各个部分都被计算了。

   Result := FloatToStr(MAll);
   If WorkState = 2 Then //顺便把ReactorOrOutPut的式量计算了
      ReactorOrOutPut^.Mass := MAll;
End;
////

Function GetEquationResult(Equation : String) : Single; //包涵　+*/的一元一次方程求解器,未知数只能为一个字母
Var
   Unknown : Char; //存储未知数
   LNum1, LNum2, RNum1, RNum2 : Single;
   i : Integer;
Begin
   For i := 1 To Length(Equation) Do //寻找未知数，并存入UnKnown,给 Simplify　函数
      If Equation[i] In Alpha = true Then Begin
         Unknown := Equation[i];
         Break; //找到后跳出循环
      End;

   i := pos('=', Equation); //寻找等号，将方程分为两个一元一次多项式
   Simplify(Copy(Equation, 1, i - 1), Unknown, LNum1, LNum2); //对左表达式进行化简
   Simplify(Copy(Equation, i + 1, Length(Equation) - i), Unknown, RNum1, RNum2); //对右表达式进行化简

   {
     将方程化简为
      LNum1*X+LNum2=RNum1*X+RNum2  //X为未知数
     可得
      X=(RNum2-LNum2)/(LNum1-RNum1)
   }
   Result := (RNum2 - LNum2) / (LNum1 - RNum1);
End;
////

Procedure Simplify(Exp : String; Unknown : Char; Var Num1, Num2 : Single);
//对所给的一元一次式子进行化简，将未知数系数存入Num1,将化简的常数存入Num2
Var
   l, i, LastOptor : Integer;
   p1, p2 : Integer;
   tmp : Single;
   Chr : Char;
   tmpStr, tmpStr2 : String;
   Sections : Array Of String;
   SecCou : Integer;
   Function CalcMultifyDiv(S : String) : Single; //计算* /式子的值
   Var
      m_l, m_i : Integer;
      m_IsLastOptorMutify : Boolean;
   Begin
      m_l := Length(S); //取字符串长度
      Result := 1; //设结果初值为1
      LastOptor := 1; //乘号或除号的位置
      m_IsLastOptorMutify := true; //默认的第一个为乘号
      For m_i := 1 To m_l Do Begin
         Chr := S[m_i];
         If Chr In Optor = False Then Continue;
         If m_IsLastOptorMutify = true Then
            Result := Result * StrToFloat(Copy(S, LastOptor, m_i - LastOptor)) //前一个数进行乘法计算
         Else
            Result := Result / StrToFloat(Copy(S, LastOptor, m_i - LastOptor)); //前一个数进行除法计算

         m_IsLastOptorMutify := Chr = '*'; //如果此运算符为"*"，则m_IsLastOptorMutify为True,否则为False
         LastOptor := m_i + 1;
      End;
   End;
Begin
   {
   本化简器只为程序服务，化简功能并不完善，只支持未知数在系数左边,只有加法，
   乘法，除法,但对求溶液浓度与质量足以
   }
   Exp := Exp + '+0';
   l := Length(Exp);
   LastOptor := 1;
   SecCou := 0;
   For i := 1 To l Do Begin
      Chr := Exp[i];
      If Chr = '+' Then Begin
         setLength(Sections, SecCou + 1);
         Sections[SecCou] := Copy(Exp, LastOptor, i - LastOptor); //将 x*3+5/6+3分为 x*3, 5/6, 3 各个部分
         LastOptor := i + 1;
         SecCou := SecCou + 1;
      End;
   End;

   Num1 := 0; Num2 := 0;
   For i := 0 To SecCou - 1 Do Begin //计算每个部分的值,如此部分有未知数，则 Num1 (未知数系数)　要发生变化
      tmpStr := Sections[i];
      p1 := pos(Unknown, tmpStr); //未知数在式子中的位置，如为0，则此部分中无未知数　
      p2 := pos('*', tmpStr) + pos('/', tmpStr); //判断式子中有无* /号,如有其一，则 p2 必不为零
      If p1 <> 0 Then Begin //此Section为X与其系数
         tmpStr2 := Copy(tmpStr, p1 + 2, Length(tmpStr) - p1 - 1) + '*';
         tmp := CalcMultifyDiv(tmpStr2);
         Num1 := Num1 + tmp; //为Num1赋新值
         Continue;
      End Else //此Section为常数
         If (p2 <> 0) Then //带*/的常数
            Num2 := Num2 + CalcMultifyDiv(tmpStr + '*') //为Num1赋新值
         Else //不带*/的常数
            Num2 := Num2 + StrToFloat(tmpStr); //为Num1赋新值
   End;
End;
////

/////////////// Class TBalancer ////////////////TBalancer的实现/////////////////
Procedure TBalancer.Work; //进行配平
Begin
   GetElementTypes; //获取所用到的各种元素
   RebuildReactors; //重构各反应物与生成物,获取每种元素出现次数
   PrepareEquations; //准备方程组
   GetNums; //解方程组，获得各反应物与生成物的系数
End;
////

Procedure TBalancer.GetElementTypes; //获取所用到的各种元素
Var
   i, t, Index : Integer;
   tmpStr, Element : String;
   l : Integer;
   Chr : Char;
Begin
   Elements := TStringList.Create;
   For i := 0 To ReactorsCou - 1 Do Begin //获取元素种类，只要访问所的反应物即可
      tmpStr := Actors[i].Str; //取化学式
      l := Length(tmpStr);
      For t := 1 To l Do Begin
         Chr := tmpStr[t];
         If Chr In HighAlpha Then Begin
            If t = l Then //防止t+1冒出，发生错误
               Element := Chr
            Else
               If tmpStr[t + 1] In LowAlpha Then
                  Element := Copy(tmpStr, t, 2) //两个字符的元素
               Else
                  Element := Chr; //单个字符的元素

            If Elements.Find(Element, Index) = False Then //如果元素列表中无此元素，则添加
               Elements.Add(Element);
         End;
      End;
   End;
   Elements.Sort; //排序
   t := Elements.Count; //元素种类数目
   For i := 0 To AllCou - 1 Do Begin
      setLength(Actors[i].EachElementCou, t);
      For l := 0 To t - 1 Do
         Actors[i].EachElementCou[l] := 0;
   End;
End;
////

Procedure TBalancer.RebuildReactors; //重构各反应物与生成物,获取每种元素出现次数
Var
   i : Integer;
Begin
   AllElements := Elements;
   For i := 0 To AllCou - 1 Do Begin
      ReactorOrOutPut := @Actors[i];
      GetMassOfFormula(Actors[i].Str, 2); //进行元素出现次数的统计,GetMassOfFormula函数的参数State=2
   End;
End;
////

Procedure TBalancer.PrepareEquations; //准备方程组
Var
   i, t, l, tmpNum : Integer;
   Arr : ^TEquation;
   Actor : ^TReactorOrOutPut;
Begin
   l := Elements.Count; //多少种元素

   setLength(Equations, l + 1);
   For i := 0 To l Do
      setLength(Equations[i].Nums, AllCou); //设方程的未知数为AllCou个

   For i := 0 To l - 1 Do Begin //根据元素列方程
      Arr := @Equations[i];
      Arr^.Constant := 0; //根据元素列的方程，常量均为0
      For t := 0 To AllCou - 1 Do Begin
         Actor := @Actors[t];
         If Actor^.IsReactor = true Then //获取某元素在Actors[t]中出现的次数
            tmpNum := Actor^.EachElementCou[i] //在反应物中出现,未知数系数为正
         Else
            tmpNum := -Actor^.EachElementCou[i]; //在生成物中出现,未知数系数为负
         Arr^.Nums[t] := tmpNum;
      End;
   End;

   Arr := @Equations[l]; //设第一个反应物的系数为一，又可得一方程
   Arr^.Nums[0] := 1; //第一个未知数系数为1
   For i := 1 To AllCou - 1 Do
      Arr^.Nums[i] := 0; //其余未知数系数为0
   Arr^.Constant := -1; //X=1 所以 X-1=0 常量为-1
End;
////

Procedure TBalancer.GetNums; //通过解方程组获得各反应物或生成物的系数
Var
   FractionSolves : TResultArr; //分数临时解

   Function GetUnknownsOfEquations(Eqs : TEqArr; UnknownCount : Integer) : TResultArr; //Eqs代表传递过来的方程组;UnknownCount为未知数数目。本函数可解任意化简后的n元一次的方程组
   Var
      l, x, y : Integer; //x,y为内部循环变量
      MyEqs : TEqArr; //存储消元后的方程组
      MySolves : TResultArr; //存储消元后的方程组的解
      EqForSwap : TEquation; //用于交换的临时方程
      tmpEquation, tmpEquation1, tmpEquation2 : ^TEquation; //临时方程
      _Num1, _Num2, _Num3, _Multiple1, _Multiple2 : Integer;
      {
      _Num1 为待消方程(即第一个方程)的第一个未知数的系数,_Num2为与之进行加减消元的
      方程的第一个未知数的系数,_Num3为_Num1与_Num2的最小公倍数,_Multiple1=_Num3/_Num1
      _Multiple2=_Num3/_Num2
      }
      RNum : TFraction;
      {
      //RNum存储求方程等号右边的数值;
       如
       a*X+b*Y+c=0  //a,b为未知数X,Y的系数,c为常数;Y被递归调用求出后
       RNum=-c-b*Y
       a=RNum/a
      }
   Begin
      l := Length(Eqs); //方程组内方程的数目

      For x := 0 To l - 1 Do //寻找第一个第一个未知数系数不为零的方程;本过程采取消第一个未知数的方法
         If Eqs[x].Nums[0] <> 0 Then Begin
            y := x;
            Break;
         End;

      EqForSwap := Eqs[0]; //Eqs[0]主方程，所有消元它都参加