myutil.prg

品质量管理系统 版本1.00 产品质量管理系统（简称JSMIS0）是基于Windows 95以上的 钢铁厂进行产品管理数据库软件。该系统可完成产品的质量数据管 理、化验数据管理以及监督数据管理

*:******************************************************************************
*:
*: 过程文件D:\VFP\CAPP\PROGS\MYUTIL.PRG
*:
*:	renku
*:	RIMAB CAD
*:	
*:	
*:	                                                               
*:
*: Documented using Visual FoxPro Formatting wizard version  .03
*:******************************************************************************
*:   myutil
*:   SkipMenuforFType
*:   SkipMenuForName
*:   doprocess
*:   user_getvalue
*:   user_riupdate
*:   packdbcanddbf
*:   RetPrivKeyIDXNum
*:   retordidxnum

#INCLUDE "include\tastrade.h"
FUNCTION SkipMenuforFType(ftype)
	LOCAL lidx,retval
	lfrmNum = _SCREEN.FormCount
	retval = .F.
	FOR lidx = 1   TO  lfrmNum
		IF(TYPE("_screen.forms[lidx].oappname") = "O"  AND ALLT( _SCREEN.Forms[lidx].oAppname.filetype) = ALLT(ftype))
			retval = .T.
			EXIT
		ENDIF
	ENDFOR
	RETURN retval
ENDFUNC

FUNCTION SkipMenuForName(ftype)
ENDFUNC

FUNCTION doprocess(PRCFILE, PARTCODE)
	LOCAL lcbuf, lcIdx, lcfield,lalias,lneedclosed,retval,oprcApp
	lneedclosed = .F.
	retval = ""
	loldarea = SELE(0)
	IF !(USED(TEMPIDX_DBF))
		USE (TEMPIDX_DBF) IN 0
		lneedclosed = .T.
	ENDIF
	SELE (TEMPIDX_DBF)
	lalias = Alias()
	LOCATE FOR ALLT(&lalias..temdescr) = ALLT("工艺");
		AND (&lalias..isdefault = .T.)
	IF (FOUND())
		lcbuf = &lalias..formname
		lcIdx = &lalias..templateid
	ELSE
		lcbuf = ""
	ENDIF
	IF (lneedclosed)
		USE IN &lalias
	ENDIF
	SELE (loldarea)
	IF (Empty(lcbuf) OR !FILE(IIF(".SCX" $ UPPER(ALLT(lcbuf)),ALLT(lcbuf),ALLT(lcbuf)+".scx")))
		RETURN retval
	ENDIF
	oprcApp  = CREATEOBJ("CAPPAPP", "工艺", lcIdx, .F., PRCFILE, "")
	IF (oprcApp.opengrcfile())
		retval = oprcApp.grctablename
		DO Form (lcbuf) WITH oprcApp
	ENDIF
	Release oprcApp
	RETURN retval
ENDFUNC

FUNCTION user_getvalue(updateitem,orderEXP)
	LOCAL lfnum,inum,lnnum,ARRAY lcitem[1]
	DIMENSION updateitem[5,2]
	lfnum = FCOUNT(SELECT(0))
	DIMENSION lcitem[lfnum]
	FOR inum = 1  TO lfnum
		lcitem[inum]=FIELD(inum)
	ENDFOR
	lnnum =0
	FOR inum =1 TO lfnum
		IF (UPPER(lcitem[inum]) $ UPPER(orderEXP))
			lnnum =lnnum+1
			updateitem[lnnum,1] = lcitem[inum]
			updateitem[lnnum,2] = EVAL(lcitem[inum])
		ENDIF
	ENDFOR
	DIMENSION updateitem[lnnum,2]
	RETURN    1
ENDFUNC

FUNCTION  user_riupdate(updateitem)
	* riupdate
	LOCAL llRetVal,inum,lcTemp,lflag
	llRetVal=.T.
	lflag= .F.
	lcTemp="REPLACE "
	IF UPPER(SYS(2011))="RECORD LOCKED" OR !RLOCK()
		llRetVal=.F.
	ELSE
		FOR inum =1 TO ALEN(updateitem,1)
			IF EVAL(updateitem[inum,1])<>updateitem[inum,2]
				lflag = .T.
				lcTemp =lcTemp+updateitem[inum,1] + " with  updateitem["+ALLT(STR(inum))+",2] "
			ENDIF
		ENDFOR
		IF(lflag)
			&lcTemp
		ENDIF
		UNLOCK RECORD (RECNO())
		llRetVal=pnerror=0
	ENDIF
	RETURN llRetVal
ENDFUNC

***对一个数据库和其所有的表进行清理
FUNCTION packdbcanddbf(DBNAME)
	LOCAL lOldExclusive,lolddbname,ARRAY ldbfs[1] ,inum ,ldbcopened
	lOldExclusive = SET("EXCLUSIVE")
	SET Exclusive ON
	lolddbname=SET("database")
	ldbcopened = .F.
	IF(DBUSED(DBNAME))
		ldbcopened=.T.
	ENDIF
	SET Database TO &DBNAME
	CLOSE DATABASES
	OPEN Data (DBNAME)
	PACK Database
	=ADBOBJECTS(ldbfs,'TABLE')
	FOR inum=1 TO ALEN(ldbfs)
		USE (ldbfs[inum]) Alias ("z"+ALLT(ldbfs[inum])) IN 0
		SELECT ("z"+ALLT(ldbfs[inum]))
		PACK
		USE
	ENDFOR
	CLOSE Database
	SET Exclusive &lOldExclusive
	IF(ldbcopened)
		OPEN Database (DBNAME)
	ENDIF
	SET Database TO &lolddbname
	RETURN .T.
ENDFUNC

****返回一表主关键字的索引号
****tag(索引号)为主关键字
***入参为工作区或别名
FUNCTION RetPrivKeyIDXNum(WORKAREA)
	LOCAL loldarea, lnum,ltag,lret
	IF PARA()=0
		WORKAREA = SELECT(0)
	ENDIF
	loldarea=SELECT(0)
	SELECT (WORKAREA)
	lnum=TagCount()
	lret = 0
	FOR ltag=1 TO lnum
		IF(Empty(Tag(ltag)))
			EXIT
		ENDIF
		IF(PRIMARY(ltag))
			lret = ltag
			EXIT
		ENDIF
	ENDFOR
	SELECT (loldarea)
	RETURN lret
ENDFUNC

FUNCTION retordidxnum(IdxExp,WORKAREA)
	LOCAL oldarea, lnum,ltag,lret
	IF PARA()=1
		WORKAREA = SELECT(0)
	ENDIF
	oldarea = SELECT(0)
	SELECT (WORKAREA)
	ltag=TagCount()
	lret = 0
	FOR lnum = 1 TO ltag
		IF(ALLT(KEY(lnum))== ldxExp)
			lret = lnum
			EXIT
		ENDIF
	ENDFOR
	SELECT (oldarea)
	RETURN lret
ENDFUNC

function Spchr(CHAR)
  IF(TYPE(CHAR) # "C")
	RETURN ""
  ENDIF
 DO CASE
  CASE   CHAR ="\n"
   	  RETURN  CHR(13)+CHR(10)
  CASE CHAR = "\t"
	RETURN  chr(9)
  CASE CHAR = "\e"
	RETURN CHR(27)
  OTHERWISE
      RETURN CHAR
ENDCASE
ENDFUNC

function Uerrormsg(msg)
=MessageBeep(0)
WAIT WIND msg  nowait
ENDFUNC


function ZYFormCmdEnabled(btnname,choice)
local tmp 
tmp = "_screen.activeform.buttonset1."+allt(btnname)
if type(tmp) = "O"  
  if (!inlist(upper(btnname), "CMDADD","CMDEDIT"))
   return (&tmp..enabled and &tmp..visible)
  else 
   return (&tmp..enabled and &tmp..visible and &tmp..parent.editmode = choice)   
  endif  
else
   return .F.
endif      
ENDFUNC

function havetoolbar()
  return  type("OApp.oToolBar") = "O"  and ;
              type ("_screen.activeform.ctoolbar") = "C" ;
              and !empty(_screen.activeform.ctoolbar)
endfunc              

function cptable( )
local ldbf1,ldbf2
ldbf1=getfile("DBF","源表：","确定",1)
ldbf2=getfile("DBF","目标表","确定",1)
if(empty(ldbf1) or empty(ldbf2))
 return
endif
use (ldbf1) alias AAA
use (ldbf2) alias bbb in 0
scan
 SCATTER MEMVAR MEMO	
 INSERT INTO &ldbf2 FROM MEMVAR
endscan
use in aaa
use in bbb
endfunc

function Calavg(fieldname)
Calculate Avg(&fieldname) To retval for &fieldname<>0
return retval
endfunc

**-----小数科学记数法形式的四舍六入-----
function sslrx(nround,ysw)
   local zs,xs,xst,zsw,xsw,jin1,flag
   xtws=set('decimal')      &&保存系统默认小数位数 
   set decimal to ysw
   zsw=10   &&整数位数
   xsw=10   &&小数位数
   nrd=str(nround,zsw+xsw+1,xsw)      &&转换为字符串
   zs=int(nround)                     &&数值型整数
   xst='0.'+subs(nrd,at('.',nrd)+1)   &&字符型小数
   xs=val(left(xst,ysw+2))            &&数值型小数
   flag=iif(subs(xst,ysw+4)=replicate('0',xsw-ysw-1),0,1)  &&零标志
   if subs(xst,ysw+3,1)='5'
      jin1=iif(flag>0,round(1/10^ysw,ysw),iif(mod(val(subs(xst,ysw+2,1)),2)<>0,round(1/10^ysw,ysw),0))
   else 
      jin1=iif(subs(xst,ysw+3,1)>'5',round(1/10^ysw,ysw),0)
   endif
   set decimal to &xtws
   return zs+xs+jin1
endfunc

**-----数据库表→Excel工作表-----
FUNCTION ChnExcl(Tablename)
LOCAL Lc_i,Lc_j,Lc_sheet,Lc_app
Dime Lc_data(1,1)
IF !USED(Tablename)
   USE &Tablename IN 0
ENDIF
=AFIELD(Lc_stru,Tablename)
SELECT * FROM &Tablename INTO ARRAY Lc_data
WAIT WINDOW "正在进行转换,请稍候..." NOWAIT 
Lc_sheet = GETOBJECT('','Excel.sheet')
Lc_app = Lc_sheet.APPLICATION
Lc_app.VISIBLE = .T.
Lc_app.WorkBooks.ADD()
Lc_sheet = Lc_app.ACTIVESHEET
FOR Lc_i=1 TO FCOUNT(Tablename)
   Lc_sheet.CELLS(1,Lc_i).VALUE =FIELD(Lc_i,Tablename)
ENDFOR   
FOR Lc_i = 1 TO ALEN(Lc_data,1)
   FOR Lc_j = 1 TO FCOUNT(Tablename)
      IF ISNULL (Lc_data(Lc_i,Lc_j)) THEN
	  	 Lc_sheet.CELLS(Lc_i+1,Lc_j).VALUE = 0
	  ELSE
		 Lc_sheet.CELLS(Lc_i+1,Lc_j).VALUE =IIF(Lc_stru(Lc_j,2)='C', "'"+Lc_data(Lc_i,Lc_j),Lc_data(Lc_i,Lc_j))
	  ENDIF    		
   ENDFOR
ENDFOR
WAIT CLEAR
ENDFUNC