📄 hz.prg
字号:
PROCEDURE commandgroup3.Command1.Click
if !used("hzb1")
use hzb1 in 0
endif
if !used("hzb2")
use hzb2 in 0
endif
if !used("hzb3")
use hzb3 in 0
endif
select dwk
if !recc()=0
currec=recno()
else
currec=0
endif
go top
dwmc=mc
do while (!empty(dwmc) and !eof())
con=""
select hzb1
locate for mc=dwmc and tag=23
if found()
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
select hzb3
locate for mc=dwmc and tag=28
if found()
if val(sz1)<>n1
con=con+"T1.23.1<>T3.28.1 "
endif
if val(sz2)<>n2
con=con+"T1.23.2<>T3.28.2 "
endif
if val(sz3)<>n3
con=con+"T1.23.3<>T3.28.3 "
endif
if val(sz4)<>n4
con=con+"T1.23.4<>T3.28.4 "
endif
if val(sz5)<>n5
con=con+"T1.23.5<>T3.28.5 "
endif
if val(sz6)<>n6
con=con+"T1.23.6<>T3.28.6 "
endif
if val(sz7)<>n7
con=con+"T1.23.7<>T3.28.7 "
endif
locate for mc=dwmc and tag=30
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
select hzb2
locate for mc=dwmc and tag=32
if found()
if val(sz1)<>n1
con=con+"T2.32.1<>T3.30.1 "
endif
if val(sz2)<>n2
con=con+"T2.32.2<>T3.30.2 "
endif
if val(sz3)<>n3
con=con+"T2.32.3<>T3.30.3 "
endif
if val(sz4)<>n4
con=con+"T2.32.4<>T3.30.4 "
endif
if val(sz5)<>n5
con=con+"T2.32.5<>T3.30.5 "
endif
if val(sz6)<>n6
con=con+"T2.32.6<>T3.30.6 "
endif
if val(sz7)<>n7
con=con+"T2.32.7<>T3.30.7 "
endif
if empty(con)
con="数据正确"
endif
select dwk
repl sx with con
endif
endif
endif
select dwk
skip
dwmc=mc
enddo
use in hzb1
use in hzb2
use in hzb3
select dwk
if !currec=0
go currec
endif
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup3.Command2.Click
use sumapp in 0
select sumapp
repl mc with data1+"(转入)"
use in sumapp
select tag,xm,sum(val(sz1)) as sz1,sum(val(sz2)) as sz2,sum(val(sz3)) as sz3, ;
sum(val(sz4)) as sz4,sum(val(sz5)) as sz5,sum(val(sz6)) as sz6,sum(val(sz7)) as sz7 ;
from hzb1 where not delete() group by xm order by tag into dbf temp
set excl on
use sumhzb1 in 0
select sumhzb1
zap
set excl off
append from temp
repl sz1 with space(11) for alltrim(sz1)="0.00"
repl sz2 with space(11) for alltrim(sz2)="0.00"
repl sz3 with space(11) for alltrim(sz3)="0.00"
repl sz4 with space(11) for alltrim(sz4)="0.00"
repl sz5 with space(11) for alltrim(sz5)="0.00"
repl sz6 with space(11) for alltrim(sz6)="0.00"
repl sz7 with space(11) for alltrim(sz7)="0.00"
repl sz3 with "账外收入支用额" for tag=24
repl sz2 with " - - - - - - - - " for tag=24
repl sz5 with " - - - - - - - - " for tag=24
repl sz6 with "账外收入余额" for tag=24
repl mc with alltrim(data1)+"(转入)" all
report form sumhz1 prev
use in sumhzb1
select dwk
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup3.Command3.Click
use sumapp in 0
select sumapp
repl mc with data1+"(转入)"
use in sumapp
select tag,xm,sum(val(sz1)) as sz1,sum(val(sz2)) as sz2,sum(val(sz3)) as sz3, ;
sum(val(sz4)) as sz4,sum(val(sz5)) as sz5,sum(val(sz6)) as sz6,sum(val(sz7)) as sz7 ;
from hzb2 where not delete() group by xm order by tag into dbf temp
set excl on
use sumhzb2 in 0
select sumhzb2
zap
set excl off
append from temp
repl sz1 with space(10) for alltrim(sz1)="0.00"
repl sz2 with space(10) for alltrim(sz2)="0.00"
repl sz3 with space(10) for alltrim(sz3)="0.00"
repl sz4 with space(10) for alltrim(sz4)="0.00"
repl sz5 with space(10) for alltrim(sz5)="0.00"
repl sz6 with space(10) for alltrim(sz6)="0.00"
repl sz7 with space(10) for alltrim(sz7)="0.00"
repl mc with data1 all
repl mc with alltrim(data1)+"(转入)" all
report form sumhz2 prev
use in sumhzb2
select dwk
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup3.Command4.Click
use sumapp in 0
select sumapp
repl mc with data1+"(转入)"
use in sumapp
select tag,xm,sum(val(sz1)) as sz1,sum(val(sz2)) as sz2,sum(val(sz3)) as sz3, ;
sum(val(sz4)) as sz4,sum(val(sz5)) as sz5,sum(val(sz6)) as sz6,sum(val(sz7)) as sz7 ;
from hzb3 where not delete() group by xm order by tag into dbf temp
set excl on
use sumhzb3 in 0
select sumhzb3
zap
set excl off
append from temp
repl sz1 with space(10) for alltrim(sz1)="0.00"
repl sz2 with space(10) for alltrim(sz2)="0.00"
repl sz3 with space(10) for alltrim(sz3)="0.00"
repl sz4 with space(10) for alltrim(sz4)="0.00"
repl sz5 with space(10) for alltrim(sz5)="0.00"
repl sz6 with space(10) for alltrim(sz6)="0.00"
repl sz7 with space(10) for alltrim(sz7)="0.00"
repl mc with alltrim(data1)+"(转入)" all
report form sumhz3 prev
use in sumhzb3
select dwk
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup3.Command5.Click
do form jcmc
ENDPROC
PROCEDURE commandgroup4.Command1.Click
if thisform.testa()=.F.
=messagebox("请将审核软盘插入到A驱动器中后再选择本选项",48,"提示信息")
return
endif
h=fopen("a:hzb1.dbf")
if (h=-1)
=messagebox("你的软盘不包含要审核的数据,请插入正确的软盘后再选择本选项",48,"提示信息")
return
endif
=fclose(h)
curpath=sys(5)+sys(2003)
select dwk
if (recc()>0)
currec=recno()
else
currec=0
endif
set defau to a:
use hzb1 in 0
use hzb2 in 0
use hzb3 in 0
select hzb1
locate for tag=23
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
con=""
select hzb3
locate for tag=28
if val(sz1)<>n1
con=con+"T1.23.1<>T3.28.1 "
endif
if val(sz2)<>n2
con=con+"T1.23.2<>T3.28.2 "
endif
if val(sz3)<>n3
con=con+"T1.23.3<>T3.28.3 "
endif
if val(sz4)<>n4
con=con+"T1.23.4<>T3.28.4 "
endif
if val(sz5)<>n5
con=con+"T1.23.5<>T3.28.5 "
endif
if val(sz6)<>n6
con=con+"T1.23.6<>T3.28.6 "
endif
if val(sz7)<>n7
con=con+"T1.23.7<>T3.28.7 "
endif
locate for tag=30
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
select hzb2
locate for tag=32
if val(sz1)<>n1
con=con+"T2.32.1<>T3.30.1 "
endif
if val(sz2)<>n2
con=con+"T2.32.2<>T3.30.2 "
endif
if val(sz3)<>n3
con=con+"T2.32.3<>T3.30.3 "
endif
if val(sz4)<>n4
con=con+"T2.32.4<>T3.30.4 "
endif
if val(sz5)<>n5
con=con+"T2.32.5<>T3.30.5 "
endif
if val(sz6)<>n6
con=con+"T2.32.6<>T3.30.6 "
endif
if val(sz7)<>n7
con=con+"T2.32.7<>T3.30.7 "
endif
if empty(con)
con="软盘中的汇总数据正确!"
else
con="软盘中的汇总数据不正确"
endif
use in hzb1
use in hzb2
use in hzb3
=messagebox(con,48,"软盘审核结果")
set defau to (curpath)
select dwk
if currec>0
go currec
endif
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup4.Command2.Click
if thisform.testa()=.F.
=messagebox("请将要转入数据的软盘插入到A驱动器中后再选择本选项",48,"提示信息")
return
endif
h=fopen("a:hzb1.dbf")
if (h=-1)
=messagebox("你的软盘不包含要转入的数据,请插入正确的软盘后再选择本选项",48,"提示信息")
return
endif
=fclose(h)
curpath=sys(5)+sys(2003)
select dwk
if (recc()>0)
currec=recno()
else
currec=0
endif
set defau to a:
use hzb1 in 0
use hzb2 in 0
use hzb3 in 0
select hzb1
locate for tag=23
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
con=""
select hzb3
locate for tag=28
if val(sz1)<>n1
con=con+"T1.23.1<>T3.28.1 "
endif
if val(sz2)<>n2
con=con+"T1.23.2<>T3.28.2 "
endif
if val(sz3)<>n3
con=con+"T1.23.3<>T3.28.3 "
endif
if val(sz4)<>n4
con=con+"T1.23.4<>T3.28.4 "
endif
if val(sz5)<>n5
con=con+"T1.23.5<>T3.28.5 "
endif
if val(sz6)<>n6
con=con+"T1.23.6<>T3.28.6 "
endif
if val(sz7)<>n7
con=con+"T1.23.7<>T3.28.7 "
endif
locate for tag=30
n1=val(sz1)
n2=val(sz2)
n3=val(sz3)
n4=val(sz4)
n5=val(sz5)
n6=val(sz6)
n7=val(sz7)
select hzb2
locate for tag=32
if val(sz1)<>n1
con=con+"T2.32.1<>T3.30.1 "
endif
if val(sz2)<>n2
con=con+"T2.32.2<>T3.30.2 "
endif
if val(sz3)<>n3
con=con+"T2.32.3<>T3.30.3 "
endif
if val(sz4)<>n4
con=con+"T2.32.4<>T3.30.4 "
endif
if val(sz5)<>n5
con=con+"T2.32.5<>T3.30.5 "
endif
if val(sz6)<>n6
con=con+"T2.32.6<>T3.30.6 "
endif
if val(sz7)<>n7
con=con+"T2.32.7<>T3.30.7 "
endif
select hzb1
addmc=mc
use in hzb1
use in hzb2
use in hzb3
set defau to (curpath)
if empty(con)
select dwk
locate for mc=alltrim(addmc)
if found()
messtip=alltrim(addmc)+"已知转入,不能再转入!"
=messagebox(messtip,48+0,"信息提示")
else
use hzb1 in 0
select hzb1
appe from a:hzb1
use in hzb1
use hzb2 in 0
select hzb2
appe from a:hzb2
use in hzb2
use hzb3 in 0
select hzb3
appe from a:hzb3
use in hzb3
use hzb1app in 0
append from a:sumapp
use in hzb1app
use hzb2app in 0
append from a:sumapp
use in hzb2app
use hzb3app in 0
append from a:sumapp
use in hzb3app
select dwk
append blank
repl mc with alltrim(addmc)
repl rq with date()
=messagebox("数 据 转 入 完 毕 !",48+0,"信息提示")
endif
else
=messagebox("数 据 不 正 确, 不 能 转 入!",48+0,"信息提示")
endif
select dwk
if currec>0
go currec
endif
thisform.grid1.setfocus
ENDPROC
PROCEDURE commandgroup4.Command3.Click
if thisform.testa()=.F.
=messagebox("请将要一张空白软盘插入到A驱动器中后再选择本选项",48,"提示信息")
return
endif
select dwk
if (recc()>0)
currec=recno()
else
currec=0
endif
use sumhzb1 in 0
select sumhzb1
if (recc()=0)
=messagebox("数据没有汇总(1),不能转出...",48+0,"信息提示")
use in sumhzb1
return
endif
use sumhzb2 in 0
select sumhzb2
if (recc()=0)
=messagebox("数据没有汇总(2),不能转出...",48+0,"信息提示")
use in sumhzb2
return
endif
use sumhzb3 in 0
select sumhzb3
if (recc()=0)
=messagebox("数据没有汇总(3),不能转出...",48+0,"信息提示")
use in sumhzb3
return
endif
select sumhzb1
copy to a:hzb1
select sumhzb2
copy to a:hzb2
select sumhzb3
copy to a:hzb3
use sumapp in 0
select sumapp
copy to a:sumapp
use in sumhzb1
use in sumhzb2
use in sumhzb3
use in sumapp
=messagebox("数 据 转 出 完 毕!",48+0,"信息提示")
select dwk
if currec>0
go currec
endif
thisform.grid1.setfocus
ENDPROC
PROCEDURE command3.Click
report form dwb3 preview
ENDPROC
ENDDEFINE
*
*-- 结束定义: hz
**************************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -