atlib.prg

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

				pn=gn_num
				aa(10)=1
				do dispping with pn
			 endif
		endcase
endif
if gn_num=1
	do prt_title
endif
select temp
append from array aa
gn_num=cxxp()
if reccount()>1
	goto bottom
	skip -1
	do prt_cnt
endif
select spmx
use
return

*===============================
*快捷键
*===============================
procedure hot_key
ls_num=right('0000'+allt(str(val(gs_chc)-59)),4)
if file(gs_pospath+'\hot_key.dbf')
	copy file &pospath\hot_key.dbf to dat\hot_key.dbf
	erase &pospath\hot_key.dbf
endif

if not used("hot_key") .and.file("dat\hot_key.dbf")
	use dat\hot_key in 0
endif
select hot_key
loca for key_num==ls_num
if found()
	use
	gs_nost=pm
	num=num+1
	do srplu
else
	use
	return
endif
return

*===============================
*清除合计栏
*===============================				
procedure qchj
do hjxs
gn_num=cxxp()+1
gn_sfg=0
gn_yhbz=0
return

*===============================
*合计销售
*===============================
procedure hjxs
if .not.used('temp')
	use in 0 temp
endif
select temp
sum round(yj*sl,1) to gn_hj
sum round(ssje,1) to ss_zj
sum sl to ln_sl
gn_hjyh=gn_hj-ss_zj
goto bottom
aa(9)=jyj
@ 18,31 say str(gn_thbz*(gn_hj-gn_hjyh),9,1)+'0' color n/w
if gn_sfg=0
	@ 20,31 say space(10) color n/w
	@ 22,31 say space(10) color n/w
endif
@ 22,55 say str(ln_sl,10,3) color n/w
str1=left('PRICE    '+STR(aa(9),10,1)+'0'+space(20),20)
str2=left('价格     '+str(aa(9),10,1)+'0'+space(20),20)
str3=left('TOTAL    '+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0'+space(20),20)
str4=left('总计     '+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0'+space(20),20)
do dispgu with str1,str2,str3,str4
select temp
use
return

*===============================
*顾客显示屏
*===============================
procedure dispgu
parameter dst1,dst2,dst3,dst4
private strr
if .not.used('dip_conf')
	use in 0 dat\dip_conf
endif
select dip_conf
locate for status='1'
if found()
	disp_style=alltrim(dispstyle)
else
	disp_style='0'
endif
if disp_style='1'
	strr=alltrim(dst2+dst4)
else
	strr=alltrim(dst1+dst3)
endif
dip_sort=alltrim(dip_socket)
dhandle=fopen(dip_sort,1)
=fwrite(dhandle,chr(31))
=fwrite(dhandle,chr(20))
=fwrite(dhandle,chr(17))
=fwrite(dhandle,strr,40)
=fclose(dhandle)
return

*===============================
*显示屏显示
*===============================
procedure dispping
parameter ast
private ast
if empty(claa())
	gn_num=gn_num-1
	select spmx
	use
	select temp
	use
	return
endif
if ast<=13
	@ ast+3,1 say aa(1) color n/w
	@ ast+3,4 say aa(6) color n/w
	@ ast+3,11 say aa(7) color n/w
	@ ast+3,24 say aa(2) color n/w
	@ ast+3,38 say aa(3) color n/w
	@ ast+3,48 say str(aa(4),10,2) color n/w
	if right(str(aa(10),10,3),4)='.000'
		@ ast+3,58 say str(aa(10),10) color n/w
	else
		@ ast+3,58 say str(aa(10),10,3) color n/w
	endif
	@ ast+3,69 say str(aa(11),10,2) color n/w
else
	scroll 4,1,16,78,1
	@ 16,1 say aa(1) color n/w
	@ 16,4 say aa(6) color n/w
	@ 16,11 say aa(7) color n/w
	@ 16,24 say aa(2) color n/w
	@ 16,38 say aa(3) color n/w
	@ 16,48 say str(aa(4),10,2) color n/w
	if right(str(aa(10),10,3),4)='.000'
		@ 16,58 say str(aa(10),10) color n/w
	else
		@ 16,58 say str(aa(10),10,3) color n/w
	endif
	@ 16,69 say str(aa(11),10,2) color n/w
endif
return

*===============================
*处理商品输入
*===============================
function claa
if .not.used('spmx')
	use in 0 dat\spmx
endif
select spmx
do case 
	case len(alltrim(dntxm))=0 .and. left(yytxm,3)<>'290'
		aa(1)=right('00'+alltrim(str(ast)),2)
		aa(2)=alltrim(spmc)
		aa(3)=alltrim(gg)
		aa(4)=lingshouj
		aa(6)=spma
		aa(7)=yytxm
		aa(9)=aa(4)
		aa(11)=round(aa(9)*aa(10),2)
	case left(dntxm,3)='290'
		aa(11)=lingshouj
		dpma=substr(dntxm,4,6)
		dpsl=val(substr(dntxm,10,3))
		set order to spma
		seek dpma
		if found()
			aa(1)=right('00'+alltrim(str(ast)),2)
			aa(2)=alltrim(spmc)
			aa(3)=alltrim(gg)
			aa(4)=lingshouj
			aa(6)=spma
			aa(7)=yytxm
			aa(10)=dpsl
			aa(9)=round(aa(11)/aa(10),2)		
		else
			=tishiw('无此单品',1)
			return ''
		endif
	case left(yytxm,3)='290'
		aa(11)=lingshouj
		dpma=substr(yytxm,4,6)
		dpsl=val(substr(yytxm,10,3))
		set order to spma
		seek dpma
		if found()
			aa(1)=right('00'+alltrim(str(ast)),2)
			aa(2)=alltrim(spmc)
			aa(3)=alltrim(gg)
			aa(4)=lingshouj
			aa(6)=spma
			aa(7)=yytxm
			aa(10)=dpsl
			aa(9)=round(aa(11)/aa(10),2)		
		else
			=tishiw('无此单品',1)
			return ''
		endif		
endcase
return '1'

*===============================
*打印小票列标题栏
*===============================
procedure prt_title
if gs_prtstatus='0'
	return
endif
if gs_prttype='0'
	strr='品名 '+space(7)+' 原价/现价'+' 数量'+' 小计'
else
	strr=substr('编码'+space(3)+'品名'+space(20),1,22)+'   数量'+'    小计'
endif
do prt with strr
strr=replicate('=',37)
do prt with strr
return

*===============================
*打印小票中的一行
*===============================
procedure prt_cnt
if gs_prtstatus='0'
	return
endif
if gs_prttype='0'
	strr=padr(alltrim(mc),14,'')		
	strr=strr+str(yj,7,2)
	do prt with strr
	s1=spma
	s2=str(gn_thbz*sl,7,3)
	s3=str(gn_thbz*jyj,10,2)
	s4=str(gn_thbz*ssje,10,2)
	strr=s1+s2+s3+s4
	do prt with strr
else
	s1=substr(spma+' '+alltrim(mc)+space(20),1,21)
	s2=str(gn_thbz*sl,8,3)
	if right(s2,4)='.000'
		s2=str(gn_thbz*sl,8)
	endif
	s3=str(gn_thbz*yj*sl,8,2)
	strr=s1+s2+s3
	do prt with strr
endif
return

*===============================
*销售统计
*===============================
procedure total
private pk
if gn_hj>9999999.99
	=tishil('合计超出范围!')
	do alarm
	return
endif
if gn_num<=12
	@ gn_num+4,1 say '原价总计 ' color n/w
	@ gn_num+4,10 say replicate('=',64) color n/w
	@ gn_num+4,69 say str(gn_hj,9,1)+'0' color n/w
else
	scroll 4,1,16,78,1
	@ 16,1 say '原价总计 ' color n/w
	@ 16,10 say replicate('=',64) color n/w
	@ 16,69 say str(gn_hj,9,1)+'0' color n/w
endif
gn_sfg=1
if gn_yhbz=0
	str1=space(2)
	str2=space(2)
	str3=left('TOTAL'+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0',20)
	str4=left('总计 '+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0',20)
else
	str1=left('TOTAL    '+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0'+space(20),20)
	str2=left('总计     '+str(gn_thbz*(gn_hj-gn_hjyh),10,1)+'0'+space(20),20)
	str3=left('YOUHUI	'+space(6)+str(gn_hjyh,6,1)+'0'+space(20),20)
	str4=left('优惠 	'+space(6)+str(gn_hjyh,6,1)+'0'+space(20),20)
endif
do dispgu with str1,str2,str3,str4
return

*===============================
*显示屏重显
*===============================	
function cxxp
private pk,pst,pr
set color to w/w
@ 4,1 clear to  16,78
if .not.used('temp')
	use in 0 temp
endif
select temp
pst=reccount()
if pst=0
	return pst
endif
if pst<=13
	pk=pst
else
	pk=13
endif
goto pst-pk+1
for pr=1 to pk
	@ pr+3,1 say xh color n/w
	@ pr+3,4 say spma color n/w
	@ pr+3,11 say sptxm color n/w
	@ pr+3,24 say mc color n/w
	@ pr+3,38 say gg color n/w
	@ pr+3,48 say str(jyj,10,2) color n/w
	if right(str(sl,10,3),4)='.000'
		@ pr+3,58 say str(sl,10) color n/w
	else
		@ pr+3,58 say str(sl,10,3) color n/w
	endif
	@ pr+3,69 say str(ssje,10,2) color n/w
	skip
endfor
return pst
	
*===============================
*下卷屏
*===============================
procedure jp_dn
if (gn_sfg=0 .and. gn_num<14) .or. (gn_sfg=0 .and. gn_num<13)
	return
endif
if .not.used('temp')
	use in 0 temp
endif
select temp
gn_scrollfg=gn_scrollfg-1
if reccount()-12+gn_scrollfg+gn_sfg>0
	goto reccount()-12+gn_scrollfg+gn_sfg
else
	gn_scrollfg=gn_scrollfg+1
	return
endif
scroll 4,1,16,78,-1
@ 4,1 say xh color n/w
@ 4,4 say spma color n/w
@ 4,11 say sptxm color n/w
@ 4,24 say mc color n/w
@ 4,38 say gg color n/w
@ 4,48 say str(jyj,10,2) color n/w
if right(str(sl,10,3),4)='.000'
	@ 4,58 say str(sl,10) color n/w
else
	@ 4,58 say str(sl,10,3) color n/w
endif
@ 4,69 say str(ssje,10,2) color n/w
return

*===============================
*上卷屏
*===============================
procedure jp_up
if .not.used('temp')
	use in 0 temp
endif
if gn_scrollfg+gn_sfg>=0
	return
endif
gn_scrollfg=gn_scrollfg+1
scroll 4,1,16,78,1
select temp
goto reccount()+gn_scrollfg+gn_sfg
@ 16,1 say xh color n/w
@ 16,4 say spma color n/w
@ 16,11 say sptxm color n/w
@ 16,24 say mc color n/w
@ 16,38 say gg color n/w
@ 16,48 say str(jyj,10,2) color n/w
if right(str(sl,10,3),4)='.000'
	@ 16,58 say str(sl,10) color n/w
else
	@ 16,58 say str(sl,10,3) color n/w
endif
@ 16,69 say str(ssje,10,2) color n/w
return

*===============================
*顾显显示欢迎信息
*===============================
procedure dispwelcome
str1='WELCOME YOU '
str2='欢迎光临'
rq=dtoc(date())
str3=rq+space(2)+cdow(date())
str4=left(rq,4)+'年'+substr(rq,6,2)+'月'+right(rq,2)+'日'+ctow(date())
do dispgu with str1,str2,str3,str4
return

*===============================
*前台查询
*===============================
procedure qtcx
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('qtcx',8,15,14,65,"colo &p_color titl '商品信息查询'")
=actiwind('qtcx')
@ 0,2 say '查询内容' color n/w
@ 0,16 say '查询方法' color n/w
@ 0,32 say '已知信息' color n/w
=dnrect(c2x(1)-2,r2y(2)-2,c2x(12)+2,r2y(3))
=dnrect(c2x(14)-2,r2y(2)-2,c2x(22)+2,r2y(3))
=dnrect(c2x(24)-2,r2y(2)-2,c2x(44)+2,r2y(3))
set cursor off
@ 2,2 say '价格' color n/w
ls_cxnr='lingshouj'
ln_cx_step=0
if .not.used('poskb')
	use in 0 dat\poskb
endif
if .not.used('temp')
	use in 0 temp
endif
if .not.used('spmx')
	use in 0 dat\spmx
endif
select poskb
goto top
locate for funcode='46'
key_up=keycode
goto top
locate for funcode='47'
key_down=keycode
use

select temp
@ 4,2 say '请选择查询条件' color n/w
do alarm
do alarm
do while .t.
	key_cx=inkey(0)
	if key_cx<>key_up .and. key_cx<>key_down .and. key_cx<>13 .and. key_cx<>27
		loop
	endif
	if key_cx=13
		exit
	endif
	if key_cx=27
		=relewind('qtcx')
		close databases
		return
	endif
	if key_cx=key_up.and.ln_cx_step<>0
		ln_cx_step=ln_cx_step-1
	endif
	if key_cx=key_down .and. ln_cx_step<>5
		ln_cx_step=ln_cx_step+1
	endif
	do case
		case ln_cx_step=0
			@ 2,2 say '价格      ' color n/w
			ls_cxnr='lingshouj'
		case ln_cx_step=1
			@ 2,2 say '商品编码  ' color n/w
			ls_cxnr='spma'
		case ln_cx_step=2
			@ 2,2 say '商品条形码' color n/w
			ls_cxnr='yytxm'
		case ln_cx_step=3
			@ 2,2 say '商品名称  ' color n/w
			ls_cxnr='spmc'
		case ln_cx_step=4
			@ 2,2 say '规格      ' color n/w
			ls_cxnr='gg'
		case ln_cx_step=5
			@ 2,2 say '分类码    ' color n/w
			ls_cxnr='glfs'
	endcase
enddo
=uprect(c2x(1)-2,r2y(2)-2,c2x(12)+2,r2y(3))

@ 2,14 say '等于' color n/w
ls_cxgx='='
ln_cx_step=0
do while .t.
	key_cx=inkey(0)
	if key_cx<>key_up .and. key_cx<>key_down .and. key_cx<>13 .and. key_cx<>27
		loop
	endif
	if key_cx=13
		exit
	endif
	if key_cx=27
		=relewind('qtcx')
		close databases
		return
	endif
	if key_cx=key_up .and. ln_cx_step<>0
		ln_cx_step=ln_cx_step-1
	endif
	if key_cx=key_down .and. ln_cx_step<>4
		ln_cx_step=ln_cx_step+1
	endif
	do case 
		case ln_cx_step=0
			@ 2,14 say '等于    ' color n/w
			ls_cxgx='='
		case ln_cx_step=1
			@ 2,14 say '大于等于' color n/w
			ls_cxgx='>='
		case ln_cx_step=2
			@ 2,14 say '小于等于' color n/w
			ls_cxgx='<='
		case ln_cx_step=3
			@ 2,14 say '不等于  ' color n/w
			ls_cxgx='<>'
		case ln_cx_step=4
			@ 2,14 say '模糊    ' color n/w
			ls_cxgx='like'
	endcase
enddo
=uprect(c2x(14)-1,r2y(2)-2,c2x(22)+2,r2y(3))
@ 4,2 say '请输入已知条件' color n/w

do alarm
set cursor on
set color to w+/b,b/w
ls_cxtj=space(20)
@ 2,24 get ls_cxtj color n/w
read
ls_cxtj=alltrim(ls_cxtj)

if ls_cxnr='spma' .and.(ls_cxgx='>=' .or. ls_cxgx='<=')
	ls_cxtj=right('000000'+ls_cxtj,6)
endif
if ls_cxgx='like'
	ls_cxtj='%'+ls_cxtj+'%'
endif
if ls_cxnr='lingshouj'
	ls_cxtj=str(val(alltrim(ls_cxtj)),10,2)
endif

if ls_cxnr<>'lingshouj'
	ls_cxtj='['+ls_cxtj+']'
endif
ls_cxtext=ls_cxnr+' '+ls_cxgx+' '+ls_cxtj
=relewind('qtcx')

select spmx
select * from spmx where &ls_cxtext into dbf cx_temp

select cx_temp
ln_cxjl=reccount()
if ln_cxjl=0
	=tishil('无符合条件的商品!!')
	do alarm
	do delay1
	use in cx_temp
	erase cx_temp.dbf
	close databases
	return
endif

set cursor off
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('cxjl',3,10,23,70,"colo &p_color titl '查询结果'")
set color to w+/b,b/w
=actiwind('cxjl')
@ 0,1 say '编码'+space(3)+'商品条形码'+space(4)+'商品名称'+space(6)+'规格'+space(10)+'零售价' color n/w
=dnrect(c2x(0),r2y(2)-5,c2x(59),r2y(15)+2)
=uprect(c2x(0)+1,r2y(2)-4,c2x(59)-1,r2y(15)+1)
@ 16,1 say '选择的商品编码:' color n/w
=dnrect(c2x(16),r2y(16)-5,c2x(24),r2y(17)+1)
@ 16,25 say '商品名称' color n/w
=dnrect(c2x(34),r2y(16)-5,c2x(49),r2y(17)+1)
@ 18,1 say '检索出的商品有' color n/w
=dnrect(c2x(16),r2y(18)-5,c2x(21),r2y(19)+1)
@ 18,22 say '条.**本记录指向窗口最后一条**' color n/w
@ 18,16 say str(ln_cxjl,5,0)

goto top