⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 poslib.prg

📁 超市收银系统,所需系统dos6.22,ucdos,foxpro另外加上一些外设的驱动程序.
💻 PRG
📖 第 1 页 / 共 5 页
字号:
*
*=================================================
procedure gkfk
private k,kk,thisdhl
if empty(yy_n)
	do case
		case gs_yetai=[1]
	    	=xx([请输入营业员工号!],0)
			return
		case gs_yetai=[0]
			yy_n=[9999]
			aa(14)=yy_n
	endcase
endif

if num=0
    =xx([无商品交易!],0)
	return
endif
if no>9999999.99
	=xx([付款超出范围!],0)
	return
endif

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

if gi_card_num>0
   if no<hj-hjyh-gdc_fkje 
	=xx([输入付款金额!再支付现金]+alltrim(str(hj-hjyh-gdc_fkje,13,2))+'元',0)
	return
   endif
endif

fk        = 0.00
if len(allt(jy(fss,1)))=0
	jy(fss,1) = [00]
endif
if len(allt(jy(fss,4)))=0
	jy(fss,4) = [人民币]
endif

if no=0
	if fss=1
		jy(fss,2)=hj-hjyh
	else
		jy(fss,2)=hj-hjyh-jy(1,2)
	endif
else
	jy(fss,2)=no+jy(fss,2)
endif
for k=1 to fss
	fk=fk+jy(k,2)
endfor

@ 20,31 say str(thbz*fk,10,2) color 8/7
do case
	case fk<hj-hjyh.and.fss=2
		=xx([付款不足,请付清款额!],0)
		if gi_qtpdbz=1
			@ 18,60 say '●盘点  ' color 8/7
		else
			@ 18,60 say '●现金  ' color 8/7
		endif
		aa(17)=[00]
		if jy(1,1)=[00]
			jy(1,2)=jy(1,2)+jy(2,2)
			jy(2,2)=0
		endif
		fss=2
		return
	case fk<hj-HJYH.and.fss=1
		=xx([付款不足,请付清款额!],0)
		if gi_qtpdbz=1
			@ 18,60 say '●盘点  ' color 8/7
		else
			@ 18,60 say '●现金  ' color 8/7
		endif
		fss    = 2
		jy(2,2)= 0.00
		return
	case fk>=hj-hjyh
		if fss=1
			jy(1,2)=hj-hjyh
		endif
		if fss=2
			jy(2,2)=hj-hjyh-jy(1,2)
			if jy(2,2)<=0
				fss=1
				jy(2,2)=0
				jy(1,2)=hj-hjyh
			endif
		endif
        
        * 找零
		@ 22,31 say str(FK-HJ+HJYH,10,2) color 8/7
		cd_str1='PAID      '+str(thbz*FK,10,2)
		cd_str3='付款      '+str(thbz*FK,10,2)
		cd_str2='CHANGE    '+str(FK-HJ+HJYH,10,2)
		cd_str4='找零      '+str(FK-HJ+HJYH,10,2)
		do dipproce with cd_str1,cd_str2,cd_str3,cd_str4
		if tzbz=[2]
			sele temp
			repl all tzm with tzbz
		endif
		if aa(5)=[3]
			sele temp
			k=recc()
			if k#0
				go top
				for kk=1 to k
                   if val(tzm)<>5 .and.val(tzm)<>6
					  aa(5)=str(val(tzm)+4,1)
					  repl tzm with aa(5)
					endif
					skip
				endfor
			endif
		endif

		if (fss=2.and.allt(jy(1,1))#allt(jy(2,1))).or.gi_card_num>0
			sele temp
			replace all tzm with '1'+right(alltrim(tzm),1)
		endif
		do drwproce

		if not used([temp])
			use temp in 0
		endif
		if pmod_sel='1'
			pmod_sel='0'
			do prn_title
			select temp
			dele all for sl=0
			pack
			sele temp
			go top
			do while !eof()
				do prn_cnt
				sele temp
				skip
			enddo
			pmod_sel='1'
		else
			sele temp
			go bott
			if sl>0
				do prn_cnt
			else
				dele
				pack
			endif
		endif
		strr=repl([=],36)
		do prtproce with strr
		do crsjk
		m.end=1
		do creat1
		@ 22,73 say aa(16) color 8/7
		set color to 7/7
		@ 4,1 clear to 16,78
		@ 22, 8 say space(8)  color 8/7
		@ 20,55 say space(20) color 8/7
		thbz=1
		dzbz=[0]
		num=0
		for i=1 to 2
			jy(i,2)=0.00
			jy(i,3)=0.00
		endf
		jczbz=1
		yy_n=space(4)
		yy_m=space(8)
		fss=1
endcase
close database
return

*==================================================
*报警
*==================================================
procedure alarm
for i=1 to 3
	??chr(07)
endf
return

*=================================================
*等待读键
*=================================================
procedure readk
para x,y,No,chc
private rel,tm
rel=1
oldtime=seco()
do while rel=1
	curtime=seco()
	if ((curtime - oldtime>30) .or. (curtime < oldtime)) .and. num=0
		oldtime=curtime
		do data_up with 'u'
		do spit_pro
	endif

	chs=inkey(.2)
	do cmpkey with chs,6,x
enddo
do clsnum
return

*=================================================
*读键功能分类
*=================================================
procedure cmpkey
para chs,xl,x
do case
case chs>47 .and. chs<58 .or. chs=46
	if (x-xl)>14
		do clsnum
		No=0
		Nost=''
		do alarm
		return
	endif
	@ y,x say chr(chs) color 8/7
	Nost=Nost+chr(chs)
	No=val(Nost)
	x=x+1
otherwise
	if chs<>0
		if not used("poskb")
			use dat\poskb in 0
		endif
		select poskb
		locate for keycode=chs
		chc=right(padl(alltrim(FUNCODE),6,[0]),2)
		rel=0
		use
	endif
endcase
return
*================================================
*清数据栏
*================================================
procedure clsnum
x=6
y=18
@ 18,6 say space(15) color 8/7
@ 18,6 say [] color 8/7
return

*================================================
*输入PLU码
*================================================
procedure srplu
private ss,rr,st

st=99
if not used("spmx")
	use dat\spmx  in 0
endif
if not used("temp")
	use temp  in 0
endif
if num=1
	sele temp
	zap
endif
sele temp
do ccxx
go bott
aa(5)='1'

if jyj=0.00.and.recc()#0.and.sl<>0
    * 前次部类输入未进行单价确定
	=xx([单价不能为零!!],0)
	num=num-1
	sele temp
	use
	sele spmx
	use
	return
endif

if num>95
	=xx([输入商品已接近99种,请完成交易!!],1)
endif
if num=100
	=xx([输入商品已有99种,请销售或总清!!],0)
	num=num-1
	sele temp
	use
	sele spmx
	use
	return
endif
sele spmx
nost=allt(nost)

********************商品条码采用code128码时,构成规则为 10+PLU码(6位)
if left(nost,2)='10' .and. len(nost)=7
   nost=right(nost,6)
endif
********************
if len(nost)<=6
	nost=padl(allt(nost),6,[0])
	set order to spma
	seek nost
	if found()
		if sfg=1
			do tchj
			hjzkbz=0
			if num=1
				num=2
			endif
			sele spmx
		endif
		ss=num
		aa(4)=lingshoj
		aa(9)=aa(4)
		aa(10)=1
		aa(11)=aa(9)*aa(10)
		do disp1 with ss
		set colo to 7/8
	else
        =xx([无此商品编码!],0)
		num=num-1
		close database
		return
	endif
else
	do case
	case left(nost,3)=='290'.and.len(allt(nost))=13  &&捆梆
		*290 XXXXXX(商品编码) XXX(捆梆数量) C
		st=1
	case val(left(nost,2))>=20.and.val(left(nost,2))<26.and.len(allt(nost))=13    &&生鲜
		*2 XXXXXX(商品编码) XXXXX(重量克) C
		st=2
	case val(left(nost,2))>90.and.val(left(nost,2))<97.and.len(allt(nost))=13    &&部分商品变价
		*9 XXXXXX(商品编码) XXXXX(价格角) C
       if gs_bjtmbz='0'
		   st=3
	   else
	       st=99
	   endif       
		
	otherwise
		st=99
	endcase
	sele spmx
	do case
	case st=1
		set order to yytxm
		seek allt(nost)
		if !found()
		  =xx([无此商品条形码!],0)
   		  num=num-1
		  sele temp
		  use
		  sele spmx
		  use
		  return
		endif
		jg_tx=lingshoj
		bm_tx=subst(nost,4,6)
		sl_tx=round(val(subst(nost,10,3)),3)
		select spmx
		set order to spma
		seek bm_tx
		if found()
			if sfg=1
				do tchj
				hjzkbz=0
				if num=1
					num=2
				endif
				sele spmx
			endif
			ss=num
			aa(4)=round(jg_tx/sl_tx,2)
			aa(9)=jg_tx
			aa(10)=sl_tx
			aa(11)=jg_tx
			aa(7)=subst(nost,4,6)
			do disp1 with ss
			set colo to 7/8
		else
            =xx([无此商品!],0)
			num=num-1
			sele temp
			use
			sele spmx
			use
			return
		endif
	case st=2
		set order to spma
		seek subs(allt(nost),2,6)
		if !found()
            =xx([无此商品!],0)
			num=num-1
			sele temp
			use
			sele spmx
			use
			return
		else
			if sfg=1
				do tchj
				hjzkbz=0
				if num=1
					num=2
				endif
				sele spmx
			endif
			ss=num
			aa(10)=val(subst(allt(nost),8,5))/1000
			do disp2 with ss
			set colo to 7/8
		endif
	case st=3
		set order to spma
		seek subs(allt(nost),2,6)
		if !found()
            =xx([无此商品!],0)
			num=num-1
			sele temp
			use
			sele spmx
			use
			return
		else
			if sfg=1
				do tchj
				hjzkbz=0
				if num=1
					num=2
				endif
				sele spmx
			endif
			ss=num
			aa(4)=lingshoj
			aa(9)=aa(4)
			aa(10)=1
			aa(11)=aa(9)*aa(10)
			do disp1 with ss
			set colo to 7/8
		endif
	otherwise
		set order to yytxm
		seek allt(nost)
		if !found()
            =xx([无此商品条形码!],0)
			num=num-1
			sele temp
			use
			sele spmx
			use
			return
		else
			if lingshoj=0.00
				=xx([此商品单价为零,不能销售!],0)
				num=num-1
				sele temp
				use
				sele spmx
				use
				return
			endif
			if sfg=1
				do tchj
				hjzkbz=0
				if num=1
					num=2
				endif
				sele spmx
			endif
			ss=num
			aa(4)=lingshoj
			aa(9)=aa(4)
			aa(10)=1
			aa(11)=aa(9)*aa(10)
			do disp1 with ss
			set colo to 7/8
		endif
	endcase
endif

select temp
* 输入第一种商品
if num=1 
	do prn_title
endif
jczbz=1

aa(1)=right([00]+allt(str(num)),2)
sele temp
appen from array aa
lastnost=nost
sum ssje to dsp_total
cd_str1='PRICE     '+str(thbz*aa(9),10,2)
cd_str3='价格      '+str(thbz*aa(9),10,2)
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
num=ccxx()
m.end=0
if st=3
	no=val(subst(allt(nost),8,5))/10
	do srbj
endif
sele temp
if recc()>1
	go bott
	skip -1
	do prn_cnt
endif
close database
return

*=================================================
*输入商品数量
*=================================================
procedure srsl
if no>9999999.99.or.no<=0.or.num=0
    =xx([数量超出范围或无效!],0)
	return
endif
if no*aa(9)>9999999.99
    =xx([合计超出范围!],0)
	return
endif

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

select temp
goto bott
do ccxx
****** modify 10/11
if pmod_sel ='0'
   if jczbz#1
	  do prn_plu
	  do prtproce with strr
	  do prn_sl1
	  if strr#''
	    strr=space(1)+shul
   	    do prtproce with strr
	  endif
	 jczbz=1
   endif
endif
   


aa(10)=no
aa(11)=aa(10)*aa(9)
if num<13
	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
	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
sele TEMP
go NUM
repl SL with AA(10),ssje with AA(11)
sele 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

*=================================================
*合计栏的显示
*=================================================

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -