atlib.prg

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

mzf=zf
mrj=rj
mth=th
mzq=zq
mzk=zk
mbj=bj
mzr=zr
mbbdy=bbdy
mjcz=jcz
mdhhm=dhhm
gs_scmc=scmg
gs_scdh=alltrim(dhhm)
select posfzk
replace scmg with mc,zf with mzf,bj with mrj,th with mth,zq with mzq,zk with mzk,bj with mbj,zr with mzr,bbdy with mbbdy,jcz with mjcz,dhhm with mdhhm
use
select fzk
use
erase fzk.dbf
erase &gs_pospath\pos.txt
erase &gs_pospath\fzk.txt
return

*===============================
*功能代码更新
*===============================
procedure poskb_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\poskb.txt') .or. uf_filesiz(gs_pospath+'\poskb.txt')<1 .or. file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if .not.used('poskb')
	use in 0 dat\poskb
endif
select poskb
zap
append from &gs_pospath\poskb.txt delimited with tab
use
erase &gs_pospath\pos.txt
erase &gs_pospath\poskb.txt
return

*===============================
*商品明细更新
*===============================
procedure spmx_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\spmx.txt') .or. uf_filesiz(gs_pospath+'\spmx.txt')<1 .or. file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if file('spmx.txt')
	erase spmx.txt
endif
if used('spmx')
	use in spmx
endif
if file('dat\spmx.cdx')
	erase dat\spmx.cdx
endif
copy file &gs_pospath\spmx.txt to spmx.txt 
erase &gs_pospath\pos.txt
if .not.used('spmx')
	use in 0 dat\spmx
endif
select spmx
zap
append from spmx.txt delimited with tab
index on spma tag spma
index on yytxm tag yytxm
use
erase &gs_pospath\spmx.txt
erase spmx.txt
return

*===============================
*调价商品更新
*===============================
procedure spit_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\spit.txt') .or. uf_filesiz(gs_pospath+'\spit.txt')<1 .or. file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if file('spit.txt')
	erase spit.txt
endif
copy file &gs_pospath\spit.txt to spit.txt
erase &gs_pospath\pos.txt
if .not.used('spmx')
	use in 0 dat\spmx
endif
if .not.file('mx.dbf')
	select spmx
	copy stru to mx
endif
if .not.used('mx')
	use in 0 mx
endif
select mx
zap
append from spit.txt delimited with tab
goto top
st=reccount()
for i=1 to st
	m_spma=spma
	m_yytxm=yytxm
	m_dntxm=dntxm
	m_spmc=spmc
	m_dw=dw
	m_gg=gg
	m_pifaj=pifaj
	m_lingshouj=lingshouj
	m_glfs=glfs
	m_da=da
	m_zo=zo
	m_xi=xi
	m_spqc=spqc
	select spmx
	locate for spma=m_spma
	if found()
		if lingshouj<>m_lingshouj .or. pifaj<>m_pifaj 
			replace spmc with m_spmc,lingshouj with m_lingshouj,pifaj with m_pifaj
		endif
	else
		insert into spmx values(m_spma,m_yytxm,m_dntxm,m_spmc,m_dw,m_gg,m_pifaj,m_lingshouj,m_glfs,m_da,m_zo,m_xi,m_spqc)
	endif
	select mx
	skip
endfor
select spmx
use
select mx
use
erase mx.dbf
erase &gs_pospath\spit.txt
erase spit.txt
return

*===============================
*程序主窗口
*===============================
procedure mainwind
if .not.used('posfzk')
	use in 0 dat\posfzk
endif
select posfzk
mc=alltrim(scmg)+'前台销售子系统'
=setfillsty(1,7)
=drawbar(1,4,639,449)
=setcolor(15)
=drawline(0,3,639,3)
=drawline(0,3,0,449)
=dnrect(5,8,635,32)
=setfillsty(1,1)
=drawbar(6,9,634,31)
=setfillsty(1,7)
=uprect(8,12,25,27)
=drawbar(9,13,24,26)
=setcolor(15)
=drawline(11,19,22,19)
=setcolor(1)
=drawline(12,20,23,20)
=sethzcolor(15)
=sethzbkcol(1)
=sethzsize(16,16,5)
=showhz(200,12,mc)
=sethzsize(16,16,0)
=showhz(565,12,'V[1.0]版')
rq=dtoc(date())
=showhz(30,12,left(rq,4)+'年'+substr(rq,6,2)+'月'+right(rq,2)+'日')
=sethzcolor(15)
=sethzbkcol(3)
=sethzfont(2)
=sethzsize(16,16,0)
=sethzstyle(0)
=uprect(3,37,27,60)
=setfillsty(1,3)
=drawbar(4,38,26,59)
=showhz(12,41,'#')
=uprect(28,37,83,60)
=drawbar(29,38,82,59)
=showhz(40,41,'编码')
=uprect(84,37,190,60)
=drawbar(85,38,189,59)
=showhz(105,41,'条形码')
=uprect(191,37,303,60)
=drawbar(192,38,302,59)
=showhz(220,41,'名称')
=uprect(304,37,371,60)
=drawbar(305,38,370,59)
=showhz(318,41,'规格')
=uprect(372,37,459,60)
=drawbar(373,38,458,59)
=showhz(400,41,'单价')
=uprect(460,37,546,60)
=drawbar(461,38,545,59)
=showhz(483,41,'数量')
=uprect(547,37,635,60)
=drawbar(548,38,634,59)
=showhz(570,41,'小计')
=dnrect(4,64,635,425)
=uprect(5,315,190,425)
=setfillsty(1,3)
=drawbar(6,316,189,424)
=showhz(c2x(2),r2y(18),'输入')
=showhz(c2x(2),r2y(20),'收款员')
=showico(145,350,'peter.ico')
=showhz(c2x(2),r2y(22),'机器号')
=showico(145,390,'computer.ico')
=dnrect(c2x(7)-2,r2y(18)-2,c2x(22),r2y(19))
=dnrect(c2x(9)-2,r2y(20)-2,c2x(17),r2y(21))
=dnrect(c2x(9)-2,r2y(22)-2,c2x(17),r2y(23))
=uprect(191,315,355,425)
=setfillsty(1,3)
=drawbar(192,316,354,424)
=sethzcolor(15)
=sethzbkcol(3)
=showhz(c2x(25),r2y(18),'合计')
=showhz(c2x(25),r2y(20),'收款')
=showhz(c2x(25),r2y(22),'找零')
=dnrect(c2x(31),r2y(18),c2x(41),r2y(19))
=dnrect(c2x(31),r2y(20),c2x(41),r2y(21))
=dnrect(c2x(31),r2y(22),c2x(41),r2y(23))
=uprect(356,315,633,425)
=setfillsty(1,3)
=drawbar(357,316,632,424)
=sethzcolor(15)
=sethzbkcol(3)
=sethzfont(2)
=showhz(c2x(46),r2y(18),'交易方式')
=showhz(c2x(46),r2y(20),'结算方式')
=showhz(c2x(46),r2y(22),'合计数量')
=dnrect(c2x(55),r2y(18),c2x(75),r2y(19))
=dnrect(c2x(55),r2y(20),c2x(65),r2y(21))
=dnrect(c2x(55),r2y(22),c2x(65),r2y(23))
=showhz(c2x(66),r2y(22),'流水号')
=dnrect(c2x(73),r2y(22),c2x(78),r2y(23))
@ 18,7 say space(15) color n/w
@ 20,9 say space(8) color n/w
@ 22,9 say space(8) color n/w
@ 18,31 say space(10) color n/w
@ 20,31 say space(10) color n/w
@ 22,31 say space(10) color n/w
@ 22,55 say space(10) color n/w
@ 18,55 say space(20) color n/w
@ 20,55 say space(10) color n/w
@ 22,73 say space(5) color n/w
@ 20,56 say '● 现金' color n/w
@ 18,56 say '● 销售  ○退货 ' color n/w
=setcolor(7)
=drawline(2,452,549,452)
=setcolor(15)
=drawline(1,431,1,452)
=drawline(1,431,549,431)
=drawline(68,431,68,451)
=setcolor(15)
=drawline(67,431,67,451)
=drawline(546,431,546,452)
=setfillsty(1,6)
=drawbar(2,432,67,451)
=sethzcolor(15)
=sethzbkcol(3)
=showhz(6,434,'提示栏:')
=plineputs('开发商:温州安立电子技术开发有限公司  地址: 温州黎明立交桥  电话  [phone]',0,15,3)
=setcolor(15)
=rect(541,431,639,452)
=setfillsty(1,1)
=drawbar(69,432,540,451)
=drawbar(542,432,638,451)
set clock to 24,68
=sethzcolor(15)
=sethzbkcol(1)
do wlpd
if gs_flagnet='ok'
	=showhz(485,434,'*网络*')
else
	=showhz(485,434,'*单机*')
endif
@ 20,9 say alltrim(gs_skm) color n/w
@ 22,9 say right(alltrim(gs_skjh),2)+'号机' color n/w
@ 22,73 say padl(piaohao,5,'0') color n/w
if used('posfzk')
	select posfzk
	use
endif
return

*===============================
*网络判断
*===============================
procedure wlpd
if .not.file('f:\hpos\posnet.txt')
	gs_flagnet='false'
else
	gs_flagnet='ok'
endif

*===============================
*清除输入栏,初始gn_x,gn_y值
*===============================
procedure clsnum
gn_x=7
gn_y=18
@ 18,7 say space(15) color n/w
@ 18,7 say '' color n/w
return

*===============================
*处理数据
*===============================
procedure cssj
gs_chc=''
gn_no=0
gs_nost=''
if gn_num=0
	aa(1)=space(2)
	aa(2)=space(14)
	aa(3)=space(8)
	aa(4)=0.00
	if gn_thbz=1
		aa(5)='1'
	else
		aa(5)='5'
	endif
	aa(6)=space(6)
	aa(7)=space(13)
	aa(8)=space(4)
	aa(9)=0.00
	aa(10)=0.00
	aa(11)=0.00
	rq=dtoc(date())
	aa(12)=left(rq,4)+substr(rq,6,2)+right(rq,2)
	aa(13)=space(8)
	aa(14)=gs_yyn
	aa(15)=gs_skn
	aa(16)=space(5)
	aa(17)='00'
	aa(18)=space(2)
	aa(19)=gs_skjh
	aa(20)=''
	aa(21)=''
	aa(22)=''
	gn_hj=0.00
	gn_hjyh=0.00
	gn_fk=0.00
	gn_sfg=0
endif
return

*===============================
*警告
*===============================
procedure alarm
for i=1 to 3
	?? chr(7)
endfor
return

*===============================
*前台盘点
*===============================
procedure qtpd
private pfile_pd
pfile_pd=gs_pospath+'\qtpd.txt'
if gs_flagnet='ok' .and. file(pfile_pd)
	=autosize(.t.)
	p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,b/w,w/w,w+/w'
	=defiwind('qtpd',9,20,16,60,"colo &p_color titl '前台盘点'")
	=actiwind('qtpd')
	=showico(c2x(34)-5,r2y(5)-3,'whello.ico')
	@ 2,4 say '进入盘点状态' color n/w
	@ 3,4 say '按任意键继续!' color n/w
	do alarm
	do delay1
	do delay1
	=inkey(0)
	gn_qtpdbz=1
	=relewind('qtpd')
	=showhz(c2x(46),r2y(22),'盘点总量')
	@ 22,56 say '● 盘点' color n/w
endif
return

*===============================
*返回中文星期函数
*===============================
function ctow
parameter day
private pw,ww
pw=cdow(day)
do case 
	case pw='sunday'
		ww='日'
	case pw='monday'
		ww='一'
	case pw='tuesday'
		ww='二'
	case pw='wednesday'
		ww='三'
	case pw='thursday'
		ww='四'
	case pw='friday'
		ww='五'
	case pw='saturday'
		ww='六'
	otherwise
		ww=''
endcase
return '星期'+alltrim(ww)

*===============================
*读取输入键值,并循环发送和更新前台数据
*===============================
procedure readk
private pn_rel,chs
prel=1
oldtime=second()
do while prel=1
	curtime=second()
	if ( curtime-oldtime>30 .or. curtime<oldtime ) .and. gn_num=0
		oldtime=curtime
		if gs_flagnet='ok' .and. file('f:\hpos\posnet.txt')
			do data_up 
			do spit_pro
		endif
	endif
	chs=inkey(0.2)
	do cmpkey with chs,7,gn_x
enddo
do clsnum
return

*===============================
*处理输入键
*===============================
procedure cmpkey
parameter chs,xl,gn_x
do case 
	case chs>47 .and. chs<58 .or. chs=46
		if(gn_x-xl)>13
			do clsnum
			gn_no=0
			gn_nost=''
			do alarm
			return
		endif
		@ gn_y,gn_x say chr(chs) color n/w
		gs_nost=gs_nost+chr(chs)
		gn_no=val(gs_nost)
		gn_x=gn_x+1
	otherwise
		if chs<>0
			if .not.used('poskb')
				use in 0 dat\poskb
			endif
			select poskb
			locate for keycode=chs
			if found()
				gs_chc=funcode
			else
				=tishiw('没有此项功能!',0)
			endif
			prel=0
			select poskb
			use
		endif
endcase
return

*===============================
*处理输入商品
*===============================
procedure srplu
private pn,pr
if .not.used('spmx')
	use in 0 dat\spmx
endif
if .not.used('temp')
	use in 0 temp
endif
if gn_num=1
	select temp
	zap
endif
if gn_num>95 
	=tishiw('输入商品已接近99种,请完成交易!',1)
endif
if gn_num=100
	=tishiw('输入商品已有99种,请完成交易!',1)
	gn_num=gn_num-1
	select spmx
	use
	select temp
	use
	return
endif

select spmx
gs_nost=alltrim(gs_nost)
if len(gs_Nost)<=6
	gs_nost=padl(gs_nost,6,'0')
	set order to spma
	seek gs_nost
	if found()
		if lingshouj=0.00
			=tishiw('此商品单价为零,不能销售!',0)
			gn_num=gn_num-1
			select spmx
			use
			select temp
			use
			return
		endif
		if gn_sfg=1
			do qchj
			select spmx
		endif
		pn=gn_num
		aa(10)=1
		do dispping with pn
	else
		=tishiw('无此商品编码',0)
		gn_num=gn_num-1
		select spmx
		use
		select temp
		use
		return
	endif
else
	do case
		case left(gs_nost,2)='20'
			set order to spma
			seek substr(gs_nost,2,6)
			if .not.found()
				=tishiw('无此商品',0)
				gn_num=gn_num-1
				select spmx
				use
				select temp
				use
				return
			else
				if lingshouj=0.00
					=tishiw('此商品单价为零,不能销售!',0)
					gn_num=gn_num-1
					select spmx
					use
					select temp
					use
					return
				endif
				if gn_sfg=1
					do qchj
					select spmx
				endif
				pn=gn_num
				aa(10)=val(substr(gs_nost,8,5))/1000
				do dispping with pn
			endif
		otherwise
			set order to yytxm
			seek gs_nost
			if .not.found()
				=tishiw('无此商品条形码!',0)
				gn_num=gn_num-1
				select spmx
				use
				select temp
				use
				return
			else
				if lingshouj=0.00
					=tishiw('此商品单价为零,不能销售!',0)
					gn_num=gn_num-1
					select spmx
					use
					select temp
					use
					return
				endif
				if gn_sfg=1
					do qchj
					select spmx
				endif