poslib.prg

超市收银系统,所需系统dos6.22,ucdos,foxpro另外加上一些外设的驱动程序.

procedure hjxs
private k

if not used("temp")
	use temp in 0
endif
HJ=0
sele temp
sum ssje to hj
sum ssje to ss_zj
sum sl to Li_sl
hjyh=hj - ss_zj

Lg_sl=str(Li_sl,8,3)
@ 18,31 say str(thbz*(hj-HJYH),10,2) color 8/7
if sfg=0
	@ 20,31 say space(10) color 8/7
	@ 22,31 say space(10) color 8/7
endif
@ 22,55 say lg_sl color 8/7
return

*=================================================
*输入折扣率
*=================================================
procedure srzk
if num=0
	=tishil([无商品输入!!])
	do alarm
	do delay1
	return
endif
if sfg=0.and.aa(4)=0
	return
endif
if no<=0.or.no>99
    =xx([折扣率超出范围!],0)
	return
endif

if not used("temp")
	use temp in 0
endif

if sfg=0
	sele temp
	if !eof()
		li_xh_zk=val(xh)
	else
		li_xh_zk=num
	endif
	go bott
	if tzm='2'.or.tzm='6'
        =xx([已经进行了一次折扣!],0)
		goto li_xh_zk
		close database
		return
	endif
********************
	select temp
	goto bott
	do ccxx
	aa(9)=aa(9)*no/100
	aa(11)=round(aa(10)*aa(9),je_jiao)
	if num<13
		@ num+3,48 say str(aa(9),10,2) color 8/7
		if right(str(aa(10),10,3),4)='.000'
			@ num+3,58 say str(int(aa(10)),10) color 8/7
		else
			@ num+3,58 say str(aa(10),10,3) color 8/7
		endif
		@ num+3,69 say str(aa(11),10,2) color 8/7
	else
		@ 16,48 say str(aa(9),10,2) color 8/7
		if right(str(aa(10),10,3),4)='.000'
			@ 16,58 say str(int(aa(10)),10) color 8/7
		else
			@ 16,58 say str(aa(10),10,3) color 8/7
		endif
		@ 16,69 say str(aa(11),10,2) color 8/7
	endif
	aa(5)=[2]
	sele temp
	go bott
	repl jyj with aa(9),ssje with aa(11),tzm with allt(aa(5))
else     &&合计折扣
*******************
	sele temp
	if !eof()
		li_xh_zk=val(xh)
	else
		li_xh_zk=num
	endif
	locate for tzm='2'.or.tzm='6'
	if found()
        =xx([已经进行了一次折扣!],0)
		goto li_xh_zk
		close database
		return
	endif
	sele temp
	xh_la=recc()
	go top
	for la=1 to xh_la
		repl jyj with jyj*(no/100)
		repl ssje with round(jyj*sl,je_jiao)
		if thbz=-1
			replace tzm with '6'
		else
			replace tzm with '2'
		endif
		skip
	endfor
	do hjxs
	tzbz=[2]
	select temp
	goto bott
	do ccxx
	if NUM<=12
		@ num+4,1 say [总计] color 8/7
		@ num+4,5 say repl([=],64) color 8/7
		@ num+4,69 say str(hj,10,2) color 8/7
	else
		scroll 4,1,16,79,1
		@ 16,1 say [总计] color 8/7
		@ 16,5 say repl([=],64) color 8/7
		@ 16,69 say str(hj,10,2) color 8/7
	endif
hjzkbz=1
*********
endif
*hjzkbz=1
if not used("temp")
	use temp in 0
endif
select temp
sum ssje to dsp_total
cd_str1=space(20)
cd_str3=space(20)
cd_str2='TOTAL     '+str(dsp_total,10,2)
cd_str4='总计      '+str(dsp_total,10,2)
do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
close database
return

*=================================================
* 输入变价
*
*=================================================
procedure srbj
if num=0
    =xx([无商品输入!],0)
	return
endif
if sfg=1
    =xx([合计后不允许变价!],0)
	return
endif
if no<=0.or.no>9999999.99
    =xx([价格超出范围!],0)
	return
endif
if no*aa(10)>9999999.99
	=xx([合计超出范围!],0)
	return
endif

if not used([temp])
	use temp in 0
endif
if not used([posfzk])
	use dat\posfzk in 0
endif

select temp
goto bott
do ccxx

aa(9)=no
aa(11)=aa(9)*aa(10)
if num<13
	@ num+3,48 say str(aa(9),10,2) color 8/7
	if right(str(aa(10),10,3),4)='.000'
		@ num+3,58 say str(int(aa(10)),10) color 8/7
	else
		@ num+3,58 say str(aa(10),10,3) color 8/7
	endif
	@ num+3,69 say str(aa(11),10,2) color 8/7
else
	@ 16,48 say str(aa(9),10,2) color 8/7
	if right(str(aa(10),10,3),4)='.000'
		@ 16,58 say str(int(aa(10)),10) color 8/7
	else
		@ 16,58 say str(aa(10),10,3) color 8/7
	endif
	@ 16,69 say str(aa(11),10,2) color 8/7
endif

if aa(4)#0.00
	aa(5)=[2]
else
	aa(4)=aa(9)
endif
sele temp
go bott
repl yj with aa(4),jyj with aa(9),ssje with aa(11),tzm with allt(aa(5))
close database
return
*=================================================
*显示合计(单品输入完成)
*=================================================
procedure total
private k
if num=0.or.aa(4)=0
	return
endif
if hj>9999999.99
	=tishil('合计超出范围!!')
	do alarm
	return
endif

if NUM<=12
	@ num+4,1 say [总计] color 8/7
	@ num+4,5 say repl([=],64) color 8/7
	@ num+4,69 say str(hj,10,2) color 8/7
else
	scroll 4,1,16,79,1
	@ 16,1 say [总计] color 8/7
	@ 16,5 say repl([=],64) color 8/7
	@ 16,69 say str(hj,10,2) color 8/7
endif
flag_jmk=0
sfg=1
tzbz=[1]
cd_str1=space(20)
cd_str3=space(20)
cd_str2='TOTAL     '+str(thbz*(HJ-HJYH),10,2)
cd_str4='总计      '+str(thbz*(HJ-HJYH),10,2)
do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
return

*=================================================
*输入信用卡号或支票号
*=================================================
procedure srph
private st,k

if fss=2
	fss=1
endif

if sfg=0
	=tishil([请合计后再进行结算!!])
	do alarm
	return
endif

if num=0
	=tishil([无商品交易!!])
	do alarm
	return
endif

st=str(val(chc)-34)
jy(fss,1)=allt(st)
select 0
use dat\posfbk
sele posfbk
st=right('00'+allt(st),2)
locate for allt(bzbh)==allt(st)
if !found()
	=tishil([无此结算方式!!])
	do alarm
	select posfbk
	use
	return
endif

jy(fss,1)=allt(st)
jy(fss,4)=allt(bzmc)
@ 18,60 say '●'+left(allt(bzmc)+space(6),6) color 8/7

if skbz='1' .and. flag_jmk=0
*       =autoSize(.t.)             && 设置无级缩放
	P_Color='B/W,W+/B,W/W,W+/B,W/B,W+/B,GR/W,W/B,N/W,W+/W'    && 建立窗口
	=DefiWind('readcard',8,20,17,60,"colo &P_Color titl '请刷卡'")
	=tishil([请刷卡......])
	do alarm
	set colo to w+/b,b/w
	=ActiWind('readcard')
	=dnrect(C2X(2),R2Y(1)-5,C2X(36),R2Y(8)+2)
	=uprect(C2X(2)+1,R2Y(1)-4,C2X(36)-1,R2Y(8)+1)
	=ShowIco(C2X(34)-5,R2Y(7)-3,'NOTE.ICO')
	@ 2,7 say [会员卡号为:] color 8/7
	=dnrect(C2X(10)-2,R2Y(4)-2,C2X(30)+2,R2Y(5))
	@ 2,7 say [会员卡号为:] color 8/7
	cardfg=1
	cardn=0
	do while cardfg=1 .and. cardn<3
		set cursor on
		set colo to w+/b,b/w
		string1=space(20)
		@4,10 get string1 color w/w
		read
		if len(alltrim(string1))=17
			string1=substr(string1,2,15)
			string2=left(string1,6)
			string3=right(string1,9)
			string4=''
			l=1
			do while l<7
				string5=substr(string2,l,1)
				nn=10-val(string5)
				string6=substr(string3,nn,1)
				string4=string4+string6
				l=l+1

			enddo
			kahao=string4
			string1=space(20)
			@4,10 say string1 color w/w
			@4,10 say kahao color 8/7
			hblx=bzbh
*hblx=bih
			select posfbk
			no=dhl*100
			use
			set cursor off
			@ 6,7 say [请核对!!!] color 8/7
			a=inkey(0)
			set cursor on
			=ReleWind('readcard')
			do srzk
			do hjxs
			flag_jmk=1
			No=0
			Nost=''
			return
		else
			cardn=cardn+1
			loop
		endif
	enddo
	@5,1 say '本卡无效:'+space(18)
	do alarm
	do delay1
	do alarm
	do delay1
	No=0
	Nost=''
	=ReleWind('readcard')
	select posfbk
	use
	return
else
	if skbz='1'
		select posfbk
		use
		return
	endif
endif

if hjbz='0'         &&不含金
	jy(fss,2)=0
	jy(fss,3)=(hj-hjyh-jy(1,3))*(1-dhl)
	if tzbz=[1]
		tzbz=[2]
	endif
	cd_str1=space(20)
	cd_str3=space(20)
	cd_str2='TOTAL     '+str(thbz*(HJ-HJYH),10,2)
	cd_str4='总计      '+str(thbz*(HJ-HJYH),10,2)
	do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
else
	if no=0
		jy(fss,2)=hj-hjyh
		fss=fss+1
	else
		jy(fss,2)=no
		fss=fss+1
	endif
*       =autoSize(.t.)             && 设置无级缩放
	P_Color='B/W,W+/B,W/W,W+/B,W/B,W+/B,GR/W,W/B,N/W,W+/W'    && 建立窗口
	=DefiWind('readcard',8,20,17,60,"colo &P_Color titl '信用卡付款'")
	=tishil([请核对......])
	do alarm
	set colo to w+/b,b/w
	=ActiWind('readcard')
	=dnrect(C2X(2),R2Y(1)-5,C2X(36),R2Y(8)+2)
	=uprect(C2X(2)+1,R2Y(1)-4,C2X(36)-1,R2Y(8)+1)
	@ 2,7 say left([合计为:]+space(10),14)+str(hj-hjyh,10,2) color 8/7
	@ 4,7 say left(jy(1,4)+'结算:'+space(10),14)+str(jy(1,2),10,2) color 8/7
	@ 6,7 say left([现金结算应为:]+space(10),14)+str(hj-hjyh-jy(1,2),10,2) color 8/7
	set cursor off
	a=inkey(0)
	=relewind('readcard')
	set cursor on
endif
select posfbk
use
return

*=================================================
*清窗口
*=================================================
procedure clswin
set color to 7/7
@ 4,1 clear to 16,78
@ 22,8 say space(8) color 8/7
@ 18,31 say space(10) color 8/7
@ 20,31 say space(10) color 8/7
@ 22,31 say space(10) color 8/7
@ 20,55 say space(20) color 8/7
yy_n=space(4)
yy_m=space(8)
thbz=1
num=0
return

*==================================================
*减操作(在最后一行显示要修改的商品信息)
*==================================================

procedure jcz
private k,l

if not used("temp")
	use temp in 0
endif
if not used("spmx")
	use dat\spmx in 0
endif

nost=allt(nost)
sele temp
locate for allt(xh)==allt(nost)
if !found()
	do alarm
	=tishil([此序列号商品没有找到!])
	do delay1
	return
endif
sele temp

select temp
goto val(xh)
if jczbz>2 .or. val(xh)<>recc()
	repl sl with -sl,ssje with -ssje
	do prn_cnt
endif
select temp
goto val(xh)
repl sl with 0,ssje with 0
num=ccxx()
select temp
sum ssje to dsp_total
cd_str1=space(20)
cd_str3=space(20)
cd_str2='TOTAL     '+str(dsp_total,10,2)
cd_str4='总计      '+str(dsp_total,10,2)
do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
close database
return
*==================================================
*减操作(擦除最后一行信息)
*==================================================
procedure jcz1
private k,l
jczbz=jczbz+1
if not used("temp")
	use temp in 0
endif
select temp
goto bott
skip 2-jczbz
if jczbz>2
	repl sl with -sl,ssje with -ssje
	do prn_cnt
endif
select temp
goto bott
skip 2-jczbz
repl sl with 0,ssje with 0
num=ccxx()
select temp
sum ssje to dsp_total
cd_str1=space(20)
cd_str3=space(20)
cd_str2='TOTAL     '+str(dsp_total,10,2)
cd_str4='总计      '+str(dsp_total,10,2)
do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
close database
return
*===============================================
*输入营业员工号
*===============================================
procedure sryyy
if empty(nost)
	=tishil('请输入营业员工号!')
	do alarm
	return
endif
nost=right('0000'+nost,4)
if not used("yuangzd")
	use dat\yuangzd in 0
endif
sele yuangzd
locate for allt(nost)==allt(gonghao)
if found().and.allt(leixin)==[营]
	@ 22,8 say padr(allt(xingmin),8,[ ]) color 8/7
else
	=tishil('无此营业员工号!')
	do alarm
	do delay1
	select yuangzd
	use
	return
endif
yy_n=allt(nost)
yy_m=xingmin
aa(14)=yy_n
sele yuangzd
use
return

*=======================================
*存入数据库(对总折扣率的处理)(pcxs.dbf并加入特征码为253的两条记录)
*=======================================
procedure crsjk
private k,zkl,bb,fileaaa,bbb

do slhb
if not used("spxb")
	use tradedat\spxb in 0
endif
if not used("lsbflast")
	use tradedat\lsbflast in 0
endif
if not used("netxb")
	use tradedat\netxb in 0
endif
if not used("posfzk")
	use dat\posfzk in 0
endif
bbb='\xslsnet.txt'
sele posfzk
if piaohao=99999
	repl piaohao with 0
endif
aa(16)=str(piaohao+1,5)
replace piaohao with val(aa(16))
aa(12)=left(dtoc(date()),4)+substr(dtoc(date()),6,2)+right(dtoc(date()),2)
aa(13)=time()
use
sele temp
repl all jyrq with aa(12)
repl all jysj with aa(13)
repl all yyym with aa(14)
repl all sksjph with right('00000'+alltrim(aa(16)),5)
sele tzm,spma,sptxm,jyj,sl,ssje,jyrq,;
jysj,yyym,skym,sksjph,jsbz,gklx,jihao,mbk,yj;
from temp into dbf pcxs
sele pcxs
ldc_hj=0
sum ssje to ldc_hj
go bott
if len(allt(tzm))#2
	sele pcxs
	repl all jsbz with jy(1,1)
else
	dimension bb(16)
	if gi_card_num=0
		for k=1 to 2
			bb(1)=[253]
			bb(2)=aa(6)
			bb(3)=[ ]
			bb(4)=0.00
			bb(5)=0.00
			bb(6)=jy(k,2)
			bb(7)=jyrq
			bb(8)=jysj
			bb(9)=yyym
			bb(10)=skym
			bb(11)=sksjph
			bb(12)=allt(jy(k,1))
			bb(13)=gklx
			bb(14)=jihao
			bb(15)=[03]
			bb(16)=0.00
			sele pcxs
			append from array bb