cangku.txt

仓库管理系统 入库出库登记 增加库存

SET TALK OFF
SET DELETE OFF
SET DATE ANSI
SET CENT ON

STOR 1 TO JJLAST

DO WHIL .T.
	CLOS DATA
	CLEA TYPE
	CLEA TYPE
	ON KEY
	IF NOT WEXIST("cpmainz")
	    IF SYSM(1)>641
			DEFI WIND CPMAINZ AT 0,0 SIZE 31.056,99.875 TITL "产品库存管理系统" ;
		         FONT "宋体", 12 FLOAT NOCLOSE NOMINIMIZE SYST
		ELSE
			DEFI WIND CPMAINZ AT 0,0 SIZE 25.056,84.875 TITL "产品库存管理系统" ;
		         FONT "宋体", 12 FLOAT NOCLOSE NOMINIMIZE SYST
		ENDI
		MOVE WINDOW CPMAINZ CENTER
	ENDI
	ACTI WIND CPMAINZ NOSHOW
    III=IIF(SYSM(1)>641,0,-0.5)

	_ZYHOXZ=0

	@ III+1.5,8.125 GET _ZYHOXZ PICT "@*IHT ;;;;" SIZE 1.167,8.250,6 FONT "宋体", 12
	DO DISMIT WITH [ ],III &&ENABLE THE MESSAGE OF MMAIN_MENU

    IF III=0
		@ 7.333,24.750 SAY "产品库存管理系统" FONT "宋体", 36 STYL "TB"
		@ 19.278,36.125 SAY "作者：赵绪华 曹毅 李博 王方剑" FONT "宋体", 12 STYL "T"

	ELSE
		@ 8.5,23.750 SAY "产品库存管理系统" FONT "宋体", 28 STYL "TB"
		@ 15.878,32.125 SAY "作者：赵绪华 曹毅 李博 王方剑" FONT "宋体", 12 STYL "T"
	ENDI
	ACTI WIND CPMAINZ
	READ CYCL MODA OBJE JJLAST
	IF (LAST()=27 AND _ZYHOXZ<1) OR _ZYHOXZ=5
		EXIT
	ENDI
	DO DISMIT WITH [COLO 3/7*],III  && DISABLE THE MESSAGE OF MMAIN_MENU
	JJLAST=_ZYHOXZ
	DO SUBMENU WITH _ZYHOXZ
	CLOS DATA
	CLEA TYPE
ENDD
RELE WIND CPMAINZ
CLOS DATA ALL
ON ERRO
ON KEY
RETU
**********
PROC DISMIT
**********
PARA MYCOLO,AIROW
@ AIROW+1.5,08.225 SAY "数据录入" FONT "宋体", 12 STYL "T" &MYCOLO
@ AIROW+1.5,22.575 SAY "数据查询" FONT "宋体", 12 STYL "T" &MYCOLO
@ AIROW+1.5,36.750 SAY "报表输出" FONT "宋体", 12 STYL "T" &MYCOLO
@ AIROW+1.5,51.000 SAY "代码维护" FONT "宋体", 12 STYL "T" &MYCOLO
@ AIROW+1.5,65.375 SAY "结束本例" FONT "宋体", 12 STYL "T" &MYCOLO
RETU
**********
PROC SUBMENU
**********
PARA MIMO
DO CASE
	CASE MIMO=1
	     PITE=[\<1 入库数据录入;\<2 销售数据录入;\<3  数据初始化 ;\<0 退出本选择单]
	CASE MIMO=2
		 PITE=[\<1 每笔入库数据查询;\<2 每笔销售数据查询;\<3 出库入库数据查询;\<4 产品库存数据查询;\<0 退出本操作选择单]
	CASE MIMO=3
		 PITE=[\<1 统计报表计算;\<2 生产销售月表;\<3 月收发存总表;\<0 退出本选择单]
	CASE MIMO=4
		 PITE=[\<1 增加糖果品种;\<2 删除糖果品种;\<3 修改代码表  ;\<0 退出本选择单]
ENDC
DO WHIL .T.
    _ZYHIN=0
	CLOS DATA ALL
	IMO=IIF(MIMO=2,5,4)
	IF NOT WEXIST("ZSUBM")
		DEFI WIND ZSUBM AT 0,0 SIZE 13,26+4*(IMO-4) FONT "宋体",12 SYST COLOR 0/7* FLOA
	    	 TITL SUBS([数据录入数据查询报表输出代码维护],(MIMO-1)*8+1,8)+"操作选项"
		MOVE WIND ZSUBM CENT
	ENDI
	ACTI WIND ZSUBM
	cho1=0
	IF IMO=4
		@ 1.5,4 GET cho1 FUNC  "*VT "+PITE FONT "宋体",12 SIZE 1.6,18,1.2 DEFA IMO
	ELSE
		@ 1,4 GET cho1 FUNC  "*VT "+PITE FONT "宋体",12 SIZE 1.6,22,0.7 DEFA IMO
	ENDI
	READ MODA CYCL OBJE IMO
	_ZYHIN=cho1
	IF (LAST()=27 AND _ZYHIN=0) OR CHO1=IMO
	   EXIT
	ELSE
		IF IMO=4
			@ 1.5,4 GET Ucho1 FUNC  "*VT "+PITE FONT "宋体",12 SIZE 1.6,18,1.2 DEFA IMO DISA
		ELSE
			@ 1,4 GET Ucho1 FUNC  "*VT "+PITE FONT "宋体",12 SIZE 1.6,22,0.7 DEFA IMO DISA
		ENDI
		CLEA GETS
		DO SUBPAC WITH MIMO*10+CHO1
		IF LAST()=27
			CLEA TYPE
			_ZYHIN=.F.
		ENDI
	ENDI
ENDD
CLOS DATA ALL
RELE WIND ZSUBM
RETU
***********
PROC SUBPAC
***********
PARA DONUM
DO CASE
	CASE INLI(DONUM,11,12)
		 DO ZCP11 WITH IIF(DONUM=11,[入库],[销售])
	CASE DONUM=13
		 AAQT=[N]
		 DO ZYHWA_SE WITH [确认数据初始化],[数据初始化将清除所有数据文件中的数据。真要执行数据初始化请按Y键:],6,AAQT
	     IF UPPE(AAQT)=[Y]
	         USE cprk
    	     ZAP
	         USE cpxs
	         ZAP
	         USE cprdata INDEX cprdata
	         ZAP
	         USE cpbb
	         ZAP
	         USE cpkc
	         ZAP
	         CLOS DATA ALL
   	 		 DO ZYHWA_SE WITH [\1],[数据初始化执行完毕。按任意键……],1
		 ELSE
	 		 DO ZYHWA_SE WITH [\1],[数据初始化没有执行。按任意键……],1
	     ENDI
	CASE INLI(DONUM,21,22,23,24)
	     DO ZCP21 WITH IIF(DONUM=21,[入库],;
	                   IIF(DONUM=22,[销售],;
	                   IIF(DONUM=23,[出入库],[库存])))
    CASE INLI(DONUM,31,32,33)
    	 PPPRG=[DO ZCP]+STR(DONUM,2,0)
    	 &PPPRG
	CASE INLI(DONUM,41,42,43)
	     DO ZCP41 WITH DONUM-40
ENDC
RETU
*********
PROC ZCP11
*********
PARA SRTYPE
CLOS DATA ALL
PRIV ALL LIKE U*
STOR DATE() TO URQ1,URQ2
DO GETRQ WITH 1,URQ1,URQ2
IF EMPT(URQ1)
   CLOS DATA
   RETU
ENDI
SELE 1
USE CPSJSR
ZAP
DO CPEMPT
GO TOP
SCAT TO UEMPTY
DEFI WIND NRLR  AT 0,0  SIZE 20.5,78 FLOA SYST COLOR RGB(0,0,0,227,236,238) ;
     TITL "输入" FONT "宋体", 12
MOVE WIND NRLR CENT
PUSH KEY CLEA
ON KEY LABE CTRL+H DO DISCAPR WITH [产品]+SRTYPE+[数据录入操作帮助],[(由赵绪华 曹毅 李博 王方剑“帮助”程序输出)],8,[M2]
ON KEY LABE F1 DO CPEMPT
ON KEY LABE CTRL+UPARROW DO ZYHUP
ON KEY LABE CTRL+DNARROW DO ZYHDN
DO WHIL .T.
IF SRTYPE=[入库]
	BROW FIEL RQ:11:H=[发生日期]:W=.F.,;
		  SRNR:H=[产品助录]:V=WHAT_CP(),;
          rksl:9:H="入库数量":P=[@Z]:W=!EMPT(CPDM),;
		  dw:5:h=[单位]:w=.f.,;
		  cpdm:4:H="代码":W=.F.,;
          cpmc:9:H="产品名称":W=.F.,;
          LB:6:H=[类别]:W=.F.,;
          EDUU=[ ]:1:H=" ":R ;
     WIND NRLR TITL [产品入库记录输入   Ctrl+W:退出   Ctrl+H:帮助] FONT "宋体", 11
ELSE
	BROW FIEL RQ:11:H=[发生日期]:W=.F.,;
		  SRNR:H=[产品助录]:V=WHAT_CP(),;
          Lssl:9:H="零售数量":P=[@Z]:W=!EMPT(CPDM),;
          Pfsl:9:H="批发数量":P=[@Z]:W=!EMPT(CPDM),;
		  dw:5:h=[单位]:w=.f.,;
		  cpdm:4:H="代码":W=.F.,;
          cpmc:9:H="产品名称":W=.F.,;
          LB:6:H=[类别]:W=.F.,;
          EDUU=[ ]:1:H=" ":R ;
     WIND NRLR TITL [产品销售记录输入    Ctrl+W:退出   Ctrl+H:帮助] FONT "宋体", 10 
ENDI
LOCA ALL FOR !EMPT(ABS(LSSL)+ABS(PFSL)+ABS(RKSL))
GO TOP
IF FOUN()
	AAQQ=1
	DO ZYHWA_SE WITH [是否存盘],[],2,AAQQ,-10,-10,[\<1 存盘;\<2 修改;\<0 放弃]
ELSE
   AAQQ=3
ENDI
IF AAQQ=2
	LOOP
ELSE
	EXIT
ENDI
ENDD
IF AAQQ=1  && SAVE TO DATABASE
   DELE ALL FOR EMPT(cpdm) OR EMPT(ABS(LSSL)+ABS(PFSL)+ABS(RKSL))
   PACK
   IF RECC()>0
      CLOS DATA ALL
      DO SAVEINSJ
   ELSE
      ZAP      
   ENDI
ENDI
RELE WIND NRLR
CLOS DATA ALL
POP KEY
RETU
********
PROC CPEMPT
********
SELE 1
UUREC=RECN()
FOR UI=1 TO 20
	APPE BLAN
	REPL RQ WITH URQ1
NEXT
IF BETW(UUREC,1,RECC(1))
	GO UUREC
ENDI
RETU
********
FUNC WHAT_CP
********
IF EMPT(SRNR)
   REPL SRNR WITH CPMC
   RETU .T.
ENDI
UUSR=STRT(SRNR,[ ],[])
UUATC=[**CANC**]
DO CASE
	CASE LEFT(UUSR,2)=[**]
		 GATH FROM UEMPTY
		 SKIP IIF(RECN()<RECC(),1,-1)
		 RETU .T.
	CASE LEFT(UUSR,1)$[?/]        && By MENU-SELECT 
		 UUATC=XZCPNA()
	CASE BETW(ASC(UUSR),48,57)    && By CPDM
		 SELE 2
		 USE CPDM ALIA CPDM
		 COUN ALL TO U_NUM FOR ALLT(CPDM)=UUSR
		 IF U_NUM=1
 		    LOCA ALL FOR ALLT(CPDM)=UUSR
		    UUATC=[@]+ALLT(CPDM.CPDM)+[@]+ALLT(CPDM.CPMC)+[@]+ALLT(CPDM.DW)+[@];
 	             +ALLT(CPDM.LB)+[@]+LTRI(STR(RECN("CPDM"),6,0))+[@]
		 ELSE
		 	IF U_NUM>1
		 		SET FILT TO CPDM=UUSR
 			    UUATC=XZCPNA()
		 	ENDI
		 ENDI
	CASE BETW(ASC(UUSR),65,122)   && By ZJM
		 UUSR=UPPE(UUSR)
		 SELE 2
		 USE CPDM ALIA CPDM
		 COUN ALL TO U_NUM FOR ALLT(ZJM)=UUSR
		 IF U_NUM=1
		    LOCA ALL FOR ALLT(ZJM)=UUSR
		    UUATC=[@]+ALLT(CPDM.CPDM)+[@]+ALLT(CPDM.CPMC)+[@]+ALLT(CPDM.DW)+[@];
 	             +ALLT(CPDM.LB)+[@]+LTRI(STR(RECN("CPDM"),6,0))+[@]
		 ELSE
		 	IF U_NUM>1
		 		SET FILT TO ZJM=UUSR
 			    UUATC=XZCPNA()
		 	ENDI
		 ENDI
	CASE ASC(UUSR)>158   && By CPMC
		 SELE 2
		 USE CPDM ALIA CPDM
		 COUN ALL TO U_NUM FOR ALLT(CPMC)=UUSR
		 IF U_NUM=1
 		    LOCA ALL FOR ALLT(CPMC)=UUSR
		    UUATC=[@]+ALLT(CPDM.CPDM)+[@]+ALLT(CPDM.CPMC)+[@]+ALLT(CPDM.DW)+[@];
 	             +ALLT(CPDM.LB)+[@]+LTRI(STR(RECN("CPDM"),6,0))+[@]
		 ELSE
		 	IF U_NUM>1
		 		SET FILT TO CPMC=UUSR
 			    UUATC=XZCPNA()
		 	ENDI
		 ENDI
	OTHE
		SELE 1
		REPL SRNR WITH CPMC
		RETU .T.
ENDC
SELE 2
USE
SELE 1
IF UUATC=[**CANC**]
   REPL SRNR WITH CPDM
   RETU .T.
ENDI
REPL CPDM WITH CPJM(1,UUATC),CPMC WITH CPJM(2,UUATC),;
     DW WITH CPJM(3,UUATC),LB WITH CPJM(4,UUATC)
REPL SRNR WITH CPMC
RETU .T.

**********
PROC ZYHUP
**********
IF RECN()=1
   RETU
ENDI
PRIV ARINI,BRSJ
SCAT TO ARINI
SKIP -1
SCAT TO BRSJ
GATH FROM ARINI
SKIP
GATH FROM BRSJ
SKIP -1
RETU

**********
PROC ZYHDN
**********
IF RECN()=RECC()
   RETU
ENDI
PRIV ARINI,BRSJ
SCAT TO ARINI
SKIP
SCAT TO BRSJ
GATH FROM ARINI
SKIP -1
GATH FROM BRSJ
SKIP
RETU
********
PROC SAVEINSJ
********
SELE 1
IF SRTYPE=[入库]
	USE cprk
ELSE
	USE cpXS
ENDI
APPE FROM cpsjsr
USE CPSJSR
SORT ON CPDM TO $0
USE $0
REPL ALL rksl with rksl-(lssl+pfsl)
TOTA ON CPDM TO $KC FIEL RKSL
USE
ERAS $0.DBF
CLOS DATA ALL

SELE 1
USE $KC
SELE 2
USE CPKC

IF RECC()=0
   APPE BLAN
   REPL RQ WITH URQ1
ELSE
   LOCA ALL FOR RQ>=URQ1
   IF !FOUN()
       GO BOTT
	   SCAT TO UUKCREC
 	   APPE BLAN
	   GATH FROM UUKCREC
	   REPL RQ WITH URQ1
   ELSE
	   IF RQ>URQ1
	   	  IF RECN()>1
	   	  	 SKIP -1
	   	  	 SCAT TO UUKCREC
	   	  	 APPE BLAN
	   	  	 GATH FROM UUKCREC
	   	  	 REPL RQ WITH URQ1
	   	  ELSE
	   	  	 INSE BLAN BEFO
	   	  	 REPL RQ WITH URQ1
	   	  ENDI
	   ENDI