PARAMETERS mysumstr
*判断是否/0
m.myyes=.f.
LOCAL m.i, m.myzero_num,j,m.myzero_str, mychar
IF "/" $ mysumstr
m.i=1
m.myzero_num=AT("/",mysumstr,m.i)
DO WHILE m.myzero_num>0
m.j=1
m.myzero_str=""
DO WHILE .T.
*IF "7541387.43" $ m.myzero_str
*susp
*ENDIF
mychar=SUBSTR(mysumstr,m.myzero_num+m.j,1)
IF ISDIGIT( mychar) OR mychar="." THEN
m.myzero_str=m.myzero_str+mychar
ENDIF
IF mychar="(" AND m.j=1
m.myzero_str=m.myzero_str+mychar
endif
IF "(" $ m.myzero_str AND INLIST(m.mychar,"+","-","*","/",SPACE(1))
m.myzero_str=m.myzero_str+mychar
endif
IF "(" $ m.myzero_str AND m.mychar=")"
m.myzero_str=m.myzero_str+mychar
IF eval(m.myzero_str)=0
m.myyes=.T.
ENDIF
EXIT
endif
IF (not("(" $ m.myzero_str) AND INLIST(m.mychar,"+","-","*","/",SPACE(1),")")) OR m.myzero_num+m.j>LEN(mysumstr)
IF empty(m.myzero_str)
EXIT
endif
PARAMETERS m.dh,m.dhyef,m.myexp,m.myrq
LOCAL m.myflag,m.mykmh,m.myye,mopertor,m.i,m.myexp_len,m.mychar,m.mysumstr,m.myyef,myrecno
IF EMPTY(m.myexp)
RETURN 0
ENDIF
m.myworkarea=SELECT()
m.myexp=STRTRAN(m.myexp,SPACE(1),"")+SPACE(2)
IF USED("tmpkmyeb")
USE IN tmpkmyeb
ENDIF
CREATE TABLE tmpkmyeb FREE (kmh c(8),ye N(16,2),yef c(1),rq d,opertor c(1),FLAG c(1))
*CREATE TABLE tmpkmyeb FREE (kmh c(8),ye N(16,2),yef c(1),rq d,opertor c(1))
m.myyef="#"
m.mykmh=""
m.myye=0
m.myopertor=""
m.i=1
m.myexp_len=LEN(myexp)
DO WHILE m.i< m.myexp_len
m.mychar=SUBSTR(m.myexp,m.i,1)
IF m.mychar="["
DO CASE
&&借方余额
CASE SUBSTR(myexp,m.i+1,1)="J" OR SUBSTR(myexp,m.i+1,1)="5"
m.myyef="5"
&&贷方余额
CASE SUBSTR(myexp,m.i+1,1)="D" OR SUBSTR(myexp,m.i+1,1)="6"
m.myyef="6"
CASE SUBSTR(myexp,m.i+1,1)="3"
m.myyef="3"
CASE SUBSTR(myexp,m.i+1,1)="4"
m.myyef="4"
CASE SUBSTR(myexp,m.i+1,1)="C"
m.myyef="C"
CASE SUBSTR(myexp,m.i+1,2)="T3"
m.myyef="7"
*!* *本年贷方累计
CASE SUBSTR(myexp,m.i+1,2)="T4"
m.myyef="8"
CASE SUBSTR(myexp,m.i+1,1)="R"
m.myyef="R"
CASE SUBSTR(myexp,m.i+1,1)="X"
m.myyef="X"
OTHERWISE
m.myyef="+"
ENDCASE
** wait windows SUBSTR(m.myexp,m.i+1,LEN(m.myexp)-m.i)+"****"+STR(AT(SUBSTR(m.myexp,m.i+1,LEN(m.myexp)-m.i),"]"))
m.i=m.i+AT("]",SUBSTR(m.myexp,m.i+1, m.myexp_len-m.i))
m.mykmh=""
IF m.i=0
EXIT
ELSE
m.i=m.i+1
ENDIF
ENDIF
mychar=SUBSTR(myexp,m.i,1)
IF ISDIGIT( mychar) OR mychar="." THEN
m.mykmh=m.mykmh+ mychar
ENDIF
IF INLIST(m.mychar,"+","-","*","/","(",")",SPACE(1))
m.myopertor=m.mychar
***************************************
m.myrecno=RECNO("zbdata")
m.myflag=LOOKUP(zbdata.yef,m.mykmh,zbdata.dh,"dh")
GO m.myrecno IN zbdata
********************************
INSERT INTO tmpkmyeb (kmh ,ye,yef,opertor,rq) VALUES(m.mykmh,0,m.myyef,m.myopertor,m.myrq)
m.myyef="#"
SELECT Tmpkmyeb.*, zbdata.dh AS kmh00, zbdata.yef AS yef00, zbdata.ye AS ye00, zbdata.curyef ;
FROM ;
tmpkmyeb ;
LEFT OUTER JOIN zbdata ;
ON Tmpkmyeb.kmh = zbdata.dh ;
WHERE (tmpkmyeb.rq=m.myrq) INTO TABLE tmpyeb
*BROWSE
REPLACE ye00 WITH 0 FOR ISNULL(kmh00)
REPLACE ye WITH ye00 ALL
REPLACE ye WITH VAL(kmh) FOR yef ="C"
*!* gaaaaaaaaaaaaaaaaaaaaaaaaaa
*IF zbdata.yef="0"
REPLACE ye WITH 0 FOR yef="5" AND ( yef00="2" OR (yef00="0" AND ye<0) )
REPLACE ye WITH 0 FOR yef="6" AND (yef00="1" OR (yef00="0" AND ye>0))
IF zbdata.yef="4"
REPLACE ye WITH ABS(ye) FOR yef00="2"
REPLACE ye WITH ABS(ye) FOR yef="6"
*!* REPLACE ye WITH ABS(ye) FOR yef="6" AND (yef00="0" AND ye<0)
*!* REPLACE ye WITH ABS(ye) FOR yef="2"
ENDIF
*endif
**REPLACE opertor WITH "+" FOR opertor="-" AND zbdata.yef="4"
***************************************
SCAN
m.myarr[1]=0
DO CASE
CASE yef="7"
SELECT SUM(je3) FROM kb00 WHERE rq>=CTOD(STR(YEAR(m.myrq),4)+"/01/01") AND rq<=m.myrq AND kmh=(tmpyeb.kmh) INTO ARRAY myarr
REPLACE ye WITH m.myarr[1]
CASE yef="8"
SELECT SUM(je4) FROM kb00 WHERE rq>=CTOD(STR(YEAR(m.myrq),4)+"/01/01") AND rq<=m.myrq AND kmh=(tmpyeb.kmh) INTO ARRAY myarr
REPLACE ye WITH m.myarr[1]*-1
ENDCASE
IF tmpyeb.opertor="("
mysumstr=mysumstr+tmpyeb.opertor
ELSE
mysumstr=mysumstr+STR(tmpyeb.ye,18,2)+tmpyeb.opertor
ENDIF
对不起,经测试EVAL表达式可超过255字符,但(路口就在不远处)所提供思路未解决“()”运算符问题。且除0判断过于简单,是否可通过 on error 来处理,但本人写简短代码结果不理想。实际上真正会计科目有借方科目,贷方科目,双向科目,为迁就公式,这其中往往不是借方用正数,贷方用负数能解决!真正会计报表生成,有关业务指标自成生成,敬请各位继续赐教!
*当calmemo更新变化时,请执行下面代码
FUNCTION new_calc
LPARAMETERS txt_calc
Local xxcaltxt,mycaltxt,caltxt,mydivtxt,divtxt,ckmtemp,cvartemp
Local aakm(1)
IF NOT USED(your_dbf_name) &&根据实际修改,保证your_dbf_name是打开的
USE your_dbf_name IN 0
ENDIF
replace your_dbf_name.mycal WITH newcalc
xxcaltxt=your_dbf_name.newcalc
xxcaltxt=Strtran(xxcaltxt,'+','+'+Chr(13)) &&加上分隔符
xxcaltxt=Strtran(xxcaltxt,'-','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'*','+'+Chr(13))
xxcaltxt=Strtran(xxcaltxt,'/','+'+Chr(13))
Use km_dbf_name In 0
Select km_dbf_name
Set Order To kemu &&科目编号为序
*km_dbf_name 为一个表,二个字段......
*字段kemu 为科目代码如11110,或常数名..
*km_calc为实际计算时用到的字段名,或变量名,或常数的值..
lnvarnum=Aline(acal,xxcaltxt) &&解析表达式
mycaltxt=""
mydivtxt=""
caltxt=""
divtxt=""
For i=1 To lnvarnum
calsign=Iif(Left(acal(i),1)$'+-*/',Left(acal(i),1),"") &&运算符
ckmtemp=Iif(Empty(calsign),acal(i),Substr(acal(i),2)) &&科目名
ckmtemp=Padr(Alltrim(ckmtemp),km_field_len) &&为了与字段一样长,km_field_len换成实际字段长
Seek (ckmtemp)
If Found()
cvartemp=km_dbf_name.km_calc
Else
Use In km_dbf_name
Messagebox("没找到科目"+ckmtemp)
Return .F.
Endif
If Len(caltxt)+Len(cvartemp)>250 &&
mycaltxt=mycaltxt+caltxt+Chr(13) &&用回车分为一段段
caltxt="" &&清空
Endif
caltxt=caltxt+calsign+cvartemp
If calsign=='/'
mydivtxt=mydivtxt+cvartemp+Chr(13)
Endif
Endfor
Use In km_dbf_name
mycaltxt=mycaltxt+caltxt+Chr(13)
Replace your_dbf_name.mycal With mycaltxt,your_dbf_name.mydiv With mydivtxt
RETURN .t.
*运算
FUNCTION now_calc
Local acal(1),lnvarnum,caltemp,caltxt,lnresult,xxcaltxt
xxcaltxt=your_dbf_name.mycal
xxdivtxt=your_dbf_name.mydiv
lnvarnum=Aline(acal,xxdivtxt) &&取所有除数
FOR i=1 TO lnvarnum
caltemp=acal(i)
IF &caltemp==0
MESSAGEBOX("除数为0,不能运算")
RETURN 0
ENDIF
ENDFOR
lnvarnum=Aline(acal,xxcaltxt) &&取所有除数
caltemp=""
For i=1 To lnvarnum
lnresult=Evaluate("caltemp"+acal(i)) &&分段计算表达式..中间结果
caltemp=lnresult
Endfor
RETURN lnresult