calcexpress.pas

delphi制作表格的控件

// 修改人: liuzhigang
// Email : [e-mail]
// 地址  : 四川.成都 (德阳)
// 
//
// 调用示例：函数 CalcExpression(M_DataSet,D_DataSet:TDataSet;Source:String):Double;
//     CalcStr=基本工资+项目工资*2-if(请假天数>5,100,if(请假天数=0,-50,50))
//     CalcExpression(DataSet,nil,CalcStr)
//     {数据字段可以为中文或英文,要求字段均为数值类型}     
//
//

unit CalcExpress;

interface
Uses Windows, Messages, SysUtils, Variants, Classes,DB;


//----------------------------- 共用变量 ---------------------------
 //------ 通用函数 -----------------------------
    Function IsNumber(Source:String):Boolean;
    Function IIF(B:Boolean;V1,V2:Integer):Integer;Overload;
    Function IIF(B:Boolean;V1,V2:Double):Double;Overload;
    Function IIF(B:Boolean;V1,V2:String):String;Overload;
    Function BigMoney(FormatStr:String;Value:Double):String;
  //---------------------------------------------
    Function CalcExpression(M_DataSet,D_DataSet:TDataSet;Source:String):Double;
    Function MainCalc(Source:String):Double;
    Function SubCalcAdd(Source:String):Double;    // 用来计算加减法
    Function SubCalcMult(Source:String):Double;   // 用来计算乘除法
  //---------------------------------------------
    Function GetFieldName(CurDataSet:TDataSet;Source:String):String;
    Function GetFieldValue(Source:String):Double;
    Function GetFieldValueAsString(CurDataSet:TDataSet;Source:String):String;
    Function GetFieldValueAsInteger(CurDataSet:TDataSet;Source:String):Integer;
    Function GetFieldValueAsDouble(CurDataSet:TDataSet;Source:String):Double;

    Function FuncAnalyzer(Source:String;iLPos,iRPos:Integer):String;
    Function IF_Analyzer(Source:String;iLPos,iRPos:Integer):String; // IF 分析单元

//==================================================================

Var
   MainDataSet,DetailDataSet:TDataSet;

implementation

Function IsNumber(Source:String):Boolean;
Var I,J,iCount:Integer;
    Value:Byte;
begin
  Result:=True;
  J:=0;
  Source:=Trim(Source);
  iCount:=Length(Source);
  For I:=1 to iCount do
  begin
     Value:=Ord(Source[I]);
     if Value=Ord('.') then
     begin
        J:=J+1;
        if (J>=2) or (I=1) or (I=iCount) then begin
           Result:=False;
           Exit;
        end;
        Continue;
     end;
     if (Value<Ord('0')) or (Value>Ord('9')) then begin
        Result:=False;
        Exit ;
     end;
  end;
end;

Function IIF(B:Boolean;V1,V2:Integer):Integer;Overload;
begin
  if B then Result:=V1 else Result:=V2;
end;

Function IIF(B:Boolean;V1,V2:Double):Double;Overload;
begin
  if B then Result:=V1 else Result:=V2;
end;

Function IIF(B:Boolean;V1,V2:String):String;Overload;
begin
  if B then Result:=V1 else Result:=V2;
end;

Function BigMoney(FormatStr:String;Value:Double):String;
var SmallMoney,BigMoney:string;
    C,C1,FrontStr,BackStr:string;
    I,DotPos,CurPos,P1,P2:Integer;
begin
   Result:='';
   CurPos:=0;
   if FormatStr='' then
      FormatStr:='0.00'
   else begin
      For I:=1 to Length(FormatStr) do
      begin
         if FormatStr[i]='0' then begin
            P1:=I;
            Break;
         end;
      end;
      For I:=Length(FormatStr) downto 1 do
      begin
         if FormatStr[i]='0' then begin
            P2:=I;
            Break;
         end;
      end;
      FrontStr:=Copy(FormatStr,1,P1-1);
      BackStr:=Copy(FormatStr,P2+1,Length(FormatStr));
      FormatStr:=Copy(FormatStr,P1,P2-P1+1);
   end;
   SmallMoney:=Formatfloat(FormatStr,Value);
   DotPos:=Pos('.',SmallMoney);{小数点的位置}
   For I:=Length(SmallMoney) downto 1 do
   begin
     if I=DotPos then
        Continue
     else if I>DotPos then
        CurPos:=DotPos-I
     else if I<DotPos then
        CurPos:=DotPos-I-1;
//--------------------------------------
     case StrToInt(SmallMoney[I]) of
         1:C:='壹'; 2:C:='贰';
         3:C:='叁'; 4:C:='肆';
         5:C:='伍'; 6:C:='陆';
         7:C:='柒'; 8:C:='捌';
         9:C:='玖'; 0:C:='零';
     end;
     case CurPos of
        -4:C1:='毫';
        -3:C1:='厘';
        -2:C1:='分';
        -1:C1:='角';
        0 :C1:='元';
        1 :C1:='拾';
        2 :C1:='佰';
        3 :C1:='千';
        4 :C1:='万';
        5 :C1:='拾';
        6 :C1:='佰';
        7 :C1:='千';
        8 :C1:='亿';
        9 :C1:='十';
       10:C1:='佰';
       11:C1:='千';
       12:C1:='万';
     else
        C1:='X';
        C:='X';
     end;
     Result:=C+C1+Result;
   end;
   Result:=FrontStr+Result+BackStr;
end;

//--------------------------------------------------------

Function CalcExpression(M_DataSet,D_DataSet:TDataSet;Source:String):Double;
Var I,iCount:Integer;
    C : Char ;
    TmpStr : String ;
begin
   MainDataSet:=M_DataSet;
   DetailDataSet:=D_DataSet;
   iCount:=Length(Source);
   For I:=1 to iCount Do
   begin
       C:=Source[I];
       if C<>' ' then TmpStr:=TmpStr+C
   End;
//------------------------------------
   Result:=MainCalc(TmpStr)
end;

Function MainCalc(Source:String):Double;
Var TmpStr:String;
    C:Char;
    I,iLeft,iRight,iLeftPos,iRightPos,iCount:Integer;
Label FirstRow;
begin
  Result:=0;
  FirstRow:
  if IsNumber(Source) then begin
     Result:=StrToFloat(Source);
     Exit;
  end;
//---------initting Data----------------------
  iLeft:=0;iRight:=0;iLeftPos:=0;iRightPos:=0;
  TmpStr:='';
//--------------------------------------------
  iCount:=Length(Source);
  For I:=1 to iCount do begin
     C:=Source[I];
     if C='(' then begin
        Inc(iLeft);
        if iLeft=1 then iLeftPos:=I
     end else if C=')' then begin
        Inc(iRight);
        if iRight=iLeft then iRightPos:=I
     end;
     if (iLeft=iRight) and (iLeft>0) then Break;
  End;
  if iLeft=0 then begin
      Result:=SubCalcAdd(Source);
      Exit;
  end;
//----------------------------------------------
  Source:=FuncAnalyzer(Source,iLeftPos,iRightPos);
  Goto FirstRow;
end;

Function SubCalcAdd(Source:String):Double;
Var I,J,iPos,iCount :Integer;
    S :Array of String;
    C,TmpStr:String;
    iTotal:Double;
begin
  J:=0 ;
  iPos:=1 ;
  iTotal:=0;
  iCount:=Length(Source);
  S:=Nil;
//-------------------------------------------
  For I:=1 to iCount do begin
    C:=Source[I];
    if (I=1) and (C='-') then Continue;
    if (C='+') or (C='-') then begin
       J:=J+1;
       SetLength(S,J);
       S[J-1]:=Copy(Source,iPos,I -iPos);
       J:=J+1;
       SetLength(S,J);
       S[J-1]:=Copy(Source,I,1);
       iPos:=I+1;
    end
  end;
  J:=J+1;
  SetLength(S,J);
  S[J-1]:=Copy(Source,iPos,(I -iPos+1));
  //For I:=Low(S) to High(S) do TmpStr:=TmpStr+S[I];
  //ShowMessage(TmpStr);
//-------------------------------------------
  For I:=Low(S) to High(S) do begin
    TmpStr:=S[I];
    if I=0 then
       iTotal:=SubCalcMult(TmpStr)
    else
       if (I-1)/2=(I-1) div 2 then
          if TmpStr='+' then
            iTotal:=iTotal + SubCalcMult(S[I+1])
          else
            iTotal:=iTotal - SubCalcMult(S[I+1])
       else
          Continue;
  end;
//-------------------------------------------
  //ShowMessage(FloatToStr(iTotal));
  Result:=iTotal ;
end;

Function SubCalcMult(Source:String):Double;
Var I,J,iCount,iPos:Integer;
    iTotal:Double;
    C:Char;
    TmpStr:String;
    S:Array of String;
begin
   if IsNumber(Source) then
   begin