delphi+sql server2000 进行自定义计算公式(50分)

jzahon · 2008-04-25

在开发固定资产进行计算折旧时，根据折旧公式（平均年限法、双倍余额递减法等）如何根据字段进行自定义计算折旧，基本字段如：设备编号,名称,资产原值,使用年限、入帐日期,折旧方式,本月折旧,累积折旧）！

iamy · 2008-04-25

公式可以用SQL自己去计算，其中还可以包含一些SQL里面的函数 其他的东西，自己写进去吧 采用宏的方式，即开宏然后执行脚本

saith · 2008-04-25

我前几天写了个公式函数,用Delphi写的, 代码在公司,我手上没有现成的. 给个提示: IIF(A>B,1,2)---公式原型 Case when A>B then 1 else 2 end  --解析成SQL语句 其中可以添套多个IIF 自己用Delphi实现吧.应该不是很难

byee · 2008-04-26

编一个语义分析器，当用户输入公式时，首先判断是否非法，然后，依据语义分析作相关处理，学过编译原理，搞这个不难把。

hbsyczxxzx · 2008-04-27

//   调用示例：函数   CalcExpression(M_DataSet,D_DataSet:TDataSet;Source:String)

ouble; //           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

ouble)

ouble;Overload;     Function   IIF(B:Boolean;V1,V2:String):String;Overload;     Function   BigMoney(FormatStr:String;Value

ouble):String;       //---------------------------------------------       Function   CalcExpression(M_DataSet,D_DataSet:TDataSet;Source:String)

ouble;     Function   MainCalc(Source:String)

ouble;     Function   SubCalcAdd(Source:String)

ouble;         //   用来计算加减法     Function   SubCalcMult(Source:String)

ouble;       //   用来计算乘除法       //---------------------------------------------       Function   GetFieldName(CurDataSet:TDataSet;Source:String):String;     Function   GetFieldValue(Source:String)

ouble;     Function   GetFieldValueAsString(CurDataSet:TDataSet;Source:String):String;     Function   GetFieldValueAsInteger(CurDataSet:TDataSet;Source:String):Integer;     Function   GetFieldValueAsDouble(CurDataSet:TDataSet;Source:String)

ouble;     Function   FuncAnalyzer(Source:String;iLPos,iRPos:Integer):String;     Function   IF_Analyzer(Source:String;iLPos,iRPos:Integer):String;   //   IF   分析单元     function SSWR(s: real):real; 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);               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,V2ouble)ouble;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;Valueouble):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='0'   then   begin                             P1:=I;                             Break;                       end;                 end;                 For   I:=Length(FormatStr)   downto   1   do                 begin                       if   FormatStr='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)   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)ouble;   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;                   if   C<>' '   then   TmpStr:=TmpStr+C           End;     //------------------------------------           Result:=MainCalc(TmpStr)     end;       Function   MainCalc(Source:String)ouble; 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;               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)ouble; Var   I,J,iPos,iCount   :Integer;           S   :Array   of   String;             C,TmpStr:String;             iTotalouble;   begin       J:=0   ;         iPos:=1   ;         iTotal:=0;         iCount:=Length(Source);         S:=Nil;     //-------------------------------------------         For   I:=1   to   iCount   do   begin             C:=Source;             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;         //ShowMessage(TmpStr);     //-------------------------------------------         For   I:=Low(S)   to   High(S)   do   begin             TmpStr:=S;             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)ouble; Var   I,J,iCount,iPos:Integer;           iTotalouble;             C:Char;             TmpStr:String;             S:Array   of   String;   begin         if   IsNumber(Source)   then           begin                 Result:=StrToFloat(Source);                 Exit;           end;           iCount:=Length(Source);           J:=0;   iTotal:=0;   iPos:=1;           For   I:=1   to   iCount   do   begin                   C:=Source;                   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;                 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.DisplayLabel=Source)   or                     (UpperCase(CurDataSet.Fields.FieldName)=                       UpperCase(Source))   then               begin                     Result:=CurDataSet.Fields.FieldName;                     Exit;               end;           end;     end;   Function   GetFieldValue(Source:String)ouble;   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.DisplayLabel=Source)   or                       (UpperCase(DetailDataSet.Fields.FieldName)=                       UpperCase(Source))   then                 begin                       Result:=DetailDataSet.Fields.AsFloat;                       Exit;                 end;           end;               NextSet:           for   I:=0   to   MainDataSet.FieldCount-1   do           begin                   if   (MainDataSet.Fields.DisplayLabel=Source)   or                         (UpperCase(MainDataSet.Fields.FieldName)=UpperCase(Source))   then                   begin                         Result:=MainDataSet.Fields.AsFloat;                         Exit;                   end;           end;         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)ouble;   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;                   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+']';           //   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[1]=''''   then   Continue                 else                           S:=FloatToStr(MainCalc(S));                 if   I<>1   then   S:=FloatToStr(MainCalc(S));     //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; function SSWR(s: real):real; var r1, r2: real; s1, s2: string; begin r1 := int(s); r2 := frac(s); s1 := copy(floattostr(r1), 1, length(floattostr(r1))); if length(floattostr(r2)) >= 5 then begin if strtoint(copy((floattostr(r2)), 5, 1)) >= 5 then if strtoint(copy((floattostr(r2)), 4, 1)) = 9 then if strtoint(copy((floattostr(r2)), 3, 1)) = 9 then begin s1 := inttostr(strtoint(s1) + 1); s2 :=''; end else S2 := inttostr(strtoint(copy((floattostr(r2)), 3, 1)) + 1) else if copy((floattostr(r2)), 3, 1) = '0' then S2 := '0' + inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) else s2 := inttostr(strtoint(copy(floattostr(r2), 3, 2)) + 1) else s2 := copy(floattostr(r2), 3, 2); end else s2 := copy(floattostr(r2), 3, 2); result := strtofloat(s1 + '.' + s2); end; end.

hbsyczxxzx · 2008-04-27

联系QQ 330955015

可视化 · 2008-04-28

应该有折旧的公式吧？我建议你建立一个表用来记录这种公式，之后根据不同的设备传递相应的参数调用就好了。我以前就是这样做的。

delphi+sql server2000 进行自定义计算公式(50分)

jzahon

Unregistered / Unconfirmed

iamy

Unregistered / Unconfirmed

saith

Unregistered / Unconfirmed

byee

Unregistered / Unconfirmed

hbsyczxxzx

Unregistered / Unconfirmed

hbsyczxxzx

Unregistered / Unconfirmed

可视化

Unregistered / Unconfirmed

Similar threads