calcexpress.pas

delphi制作表格的控件

      Result:=StrToFloat(Source);
      Exit;
   end;
   iCount:=Length(Source);
   J:=0; iTotal:=0; iPos:=1;
   For I:=1 to iCount do begin
       C:=Source[I];
       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 begin
      TmpStr:=S[I];
      if I=0 then
         if IsNumber(TmpStr) then
            iTotal:=StrToFloat(TmpStr)
         else
            iTotal:=GetFieldValue(TmpStr)
      else begin
         if (I-1)/2=(I-1) div 2 then
            if TmpStr='*' then begin
               TmpStr:=S[I+1];
               if IsNumber(TmpStr) then
                  iTotal:=StrToFloat(TmpStr)*iTotal
               else
                  iTotal:=GetFieldValue(TmpStr)*iTotal;
            end else begin
               TmpStr:=S[I+1];
               if IsNumber(TmpStr) then
                  iTotal:=iTotal/StrToFloat(TmpStr)
               else
                  iTotal:=iTotal/GetFieldValue(TmpStr)
            end
          else
            Continue
      end;
  end;
//----------------------------------
  Result:=iTotal ;
end;

//=================================================================
Function GetFieldName(CurDataSet:TDataSet;Source:String):String;
Var I,J:Integer;
begin
   Result:='';
   For I:=0 to CurDataSet.FieldCount-1 do
   begin
     if (CurDataSet.Fields[I].DisplayLabel=Source) or
        (UpperCase(CurDataSet.Fields[I].FieldName)=
         UpperCase(Source)) then
     begin
        Result:=CurDataSet.Fields[I].FieldName;
        Exit;
     end;
   end;
end;

Function GetFieldValue(Source:String):Double;
Var I,X,Y:Integer;   //如果给了@ 就表示是标准格式,否者就是从表字段；
Label NextSet;
begin
//--------------------------------------------
   if DetailDataSet=nil then Goto NextSet;
   for I:=0 to DetailDataSet.FieldCount-1 do
   begin
      if (DetailDataSet.Fields[I].DisplayLabel=Source) or
         (UpperCase(DetailDataSet.Fields[I].FieldName)=
         UpperCase(Source)) then
      begin
         Result:=DetailDataSet.Fields[I].AsFloat;
         Exit;
      end;
   end;

   NextSet:
   for I:=0 to MainDataSet.FieldCount-1 do
   begin
       if (MainDataSet.Fields[I].DisplayLabel=Source) or
          (UpperCase(MainDataSet.Fields[I].FieldName)=UpperCase(Source)) then
       begin
          Result:=MainDataSet.Fields[I].AsFloat;
          Exit;
       end;
   end;
//-------------If no found ,Raise -----
   Abort;
end;

Function GetFieldValueAsString(CurDataSet:TDataSet;Source:String):String;
Var cFieldName:String;
begin
   cFieldName:=GetFieldName(CurDataSet,Source);
   Result:=CurDataSet.FieldByName(cFieldName).AsString;
end;

Function GetFieldValueAsInteger(CurDataSet:TDataSet;Source:String):Integer;
Var cFieldName:String;
begin
   cFieldName:=GetFieldName(CurDataSet,Source);
   Result:=CurDataSet.FieldByName(cFieldName).AsInteger;
end;

Function GetFieldValueAsDouble(CurDataSet:TDataSet;Source:String):Double;
Var cFieldName:String;
begin
   cFieldName:=GetFieldName(CurDataSet,Source);
   Result:=CurDataSet.FieldByName(cFieldName).AsFloat;
end;

Function FuncAnalyzer(Source:String;iLPos,iRPos:Integer):String;
Var I,iCount:Integer;
    TmpStr:String;
begin
   iCount:=Length(Source);
   if (iLPos>=2) and (LowerCase(Copy(Source,iLPos -2,2))='if') then
	TmpStr:=IF_Analyzer(Source,iLPos,iRPos)
	//MessageBox('uf_Analyze_if',TmpStr)
   else if (iLPos>=6) and (LowerCase(Copy(Source,iLPos -2,2))='isnull') then
	//TmpStr=String(uf_Analyze_IsNull(Source))
   else if (iLPos>=4) and (LowerCase(Copy(Source,iLPos -2,2))='left') then
	//TmpStr=uf_Analyze_IsNull(Source)
   else begin
       TmpStr:=Copy(Source,1,(iLPos -1));
       TmpStr:=TmpStr+FloatToStr(MainCalc(Copy(Source,
		    iLPos+1,(iRPos -iLPos -1))));
       TmpStr:=TmpStr+Copy(Source,iRPos+1,(iCount -iRPos));

   end ;

   Result:=TmpStr
end;

Function IF_Analyzer(Source:String;iLPos,iRPos:Integer):String;
Var C,C1:Char;
    TmpStr,LeftStr,RightStr:String;
    S:Array of String;
    I,J,K,iCount,iLeft,iRight,iPos:Integer;
    Label NextRow ;
begin
   TmpStr:=Copy(Source,iLPos+1,(iRPos -iLPos -1));
   iCount:=Length(TmpStr);
   Result:='';
 //MessageBox('aaaa',TmpStr)
 //--------------------------------------------------------
   iLeft:=0 ; iRight:=0 ; iPos:=1 ; J:=0 ; K:=-1;
 //--------------------------------------------------------
   For I:=1 to iCount do begin
       if K=I then Continue;
       C:=TmpStr[I];
       if C='(' then
          iLeft:=iLeft+1
       else if C=')' then
          iRight:=iRight+1;
   //-----------------------------------
       if (C=',') and (iLeft=iRight) then begin
           J:=J+1;
           SetLength(S,J);
           S[J-1]:=Copy(TmpStr,iPos,(I -iPos)) ; iPos:=I+1;
       end
       else if (C='=') and (iLeft=iRight) then begin
           J:=J+1;
           SetLength(S,J);
           S[J-1]:=Copy(TmpStr,iPos,(I -iPos));
           J:=J+1;
           SetLength(S,J);
           S[J-1]:=C ; iPos:=I+1
       end
       else if (C='>') and (iLeft=iRight) then begin
           C1:=TmpStr[I+1];
           if C1='=' then begin
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=Copy(TmpStr,iPos,(I -iPos));
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=C+C1 ; iPos:=I+2 ; K:=I+1;
           end else begin
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=Copy(TmpStr,iPos,(I -iPos));
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=C ; iPos:=I+1
           end ;
       end else if (C='<') and (iLeft=iRight) then begin
           C1:=TmpStr[I+1];
           if (C1='=') or (C1='>') then begin
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=Copy(TmpStr,iPos,(I -iPos));
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=C+C1 ;
              iPos:=I+2 ;
              K:=I+1;
           end else begin
              J:=J+1;
              SetLength(S,1);
              S[J-1]:=Copy(TmpStr,iPos,(I -iPos));
              J:=J+1;
              SetLength(S,J);
              S[J-1]:=C ;
              iPos:=I+1
           end
	     end;
   end;
   J:=J+1;
   SetLength(S,J);
   S[J-1]:=Copy(TmpStr,iPos,(I -iPos+1));
 //----------------Debug--------------------------------
 //  TmpStr:='';
 // For I:=Low(S) to High(S) do TmpStr:=TmpStr+'['+S[I]+']';

 // ShowMessage(TmpStr);
 //MessageBox(String(J),S[J])
 //---------------------------------------------------------
  For I:=Low(S) to High(S) do begin
      if (I=0) or (I=2) then
        if S[I][1]='''' then Continue
      else
           S[I]:=FloatToStr(MainCalc(S[I]));
      if I<>1 then S[I]:=FloatToStr(MainCalc(S[I]));
	//MessageBox(String(I),S[J])
  end;
 //--------------------------------------------------------------
 LeftStr:=Copy(Source,1,(iLPos -3));
 RightStr:=Copy(Source,iRPos+1,(Length(Source) -iRPos)) ;
 //------------------------------Debug---------------------------
 if IsNumber(S[2]) then begin
    if S[1]='>' then begin
       if StrToFloat(S[0])>StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
       GoTo NextRow;
    end ;
    if S[1]='>=' then begin
       if StrToFloat(S[0])>=StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
       GoTo NextRow;
    end ;
    if S[1]='<' then begin
       if StrToFloat(S[0])<StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
       GoTo NextRow;
    end ;
    if S[1]='<=' then begin
       if StrToFloat(S[0])<=StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
       GoTo NextRow;
    end ;
    if S[1]='<>' then begin
       if StrToFloat(S[0])<>StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
       GoTo NextRow;
    end ;
    if S[1]='=' then begin
       if StrToFloat(S[0])=StrToFloat(S[2]) then TmpStr:=S[3] else TmpStr:=S[4];
    end;
 end else  begin
      if (S[1]='=') and (S[0]=Copy(S[2],2,Length(S[2])-2)) then
         TmpStr:=S[3]
      else
         TmpStr:=S[4]
 end ;

 NextRow: Result:=LeftStr+TmpStr+RightStr ;
end;

end.