📄 utility.prg

📁 简单VFP学藉管理程序V1.0,大家看看,可能会有帮助
💻 PRG
字号:
*:******************************************************************************
*:
*: 过程文件C:\IT\PROGS\UTILITY.PRG
*:
*:******************************************************************************
*-- 通用实用函数
************************************
*!******************************************************************************
*!
*! 过程 ISTAG
*!
*!******************************************************************************
#INCLUDE ..\INCLUDE\MYAPP.H 
FUNCTION IsTag (tcTagName, tcAlias)
*-- 接收一个索引名和一个别名(可选)作为参数
*-- 如果索引名在别名中存在则回 .T. 如果未传递别名就使用当前工作区
LOCAL llIsTag, ;
	lcTagFound

IF PARAMETERS() < 2
	tcAlias = ALIAS()
ENDIF

IF EMPTY(tcAlias)
	RETURN .F.
ENDIF

llIsTag = .F.
tcTagName = UPPER(ALLTRIM(tcTagName))

lnTagNum = 1
lcTagFound = TAG(lnTagNum, tcAlias)
DO WHILE !EMPTY(lcTagFound)
	IF UPPER(ALLTRIM(lcTagFound)) == tcTagName
		llIsTag = .T.
		EXIT
	ENDIF
	lnTagNum = lnTagNum + 1
	lcTagFound = TAG(lnTagNum, tcAlias)
ENDDO

RETURN llIsTag
ENDFUNC

*!******************************************************************************
*!
*! 过程 NOTYET
*!
*!******************************************************************************
FUNCTION NotYet()
*-- 用于应用程序建立初期，向用户说明程序的某功能尚未完成
=MESSAGEBOX("正在建造中", 64)
RETURN
ENDFUNC

*!******************************************************************************
*!
*! 过程 FILESIZE
*!
*!******************************************************************************
FUNCTION FileSize(tcFileName)
*-- Returns the size of a file. SET COMPATIBLE must be ON for
*-- FSIZE() to return the size of a file. Otherwise, it returns
*-- the size of a field.
LOCAL lcSetCompatible, lnFileSize

lcSetCompatible = SET('COMPATIBLE')
SET COMPATIBLE ON
lnFileSize = FSIZE(tcFileName)
SET COMPATIBLE &lcSetCompatible
RETURN lnFileSize
ENDFUNC

*!******************************************************************************
*!
*! 过程 FORMISOBJECT
*!
*!******************************************************************************
FUNCTION FormIsObject()
*-- Return .T. if the active form is of type "O" and its baseclass
*-- is "Form".
RETURN (TYPE("_screen.activeform") == "O" AND ;
	UPPER(_screen.ActiveForm.BaseClass) = "FORM")
ENDFUNC

*!******************************************************************************
*!
*! 过程 TOOLBARENABLED
*!
*!******************************************************************************
FUNCTION ToolBarEnabled
*- Return value of Toolbar object
PARAMETER oObject
LOCAL oToolObj
oToolObj = "oApp.oToolBar." + oobject + ".enabled"
IF TYPE(oToolObj) # "L"
	RETURN .F.
ELSE
	RETURN EVAL(oToolObj)
ENDIF
ENDFUNC

*!******************************************************************************
*!
*! 过程 ONSHUTDOWN
*!
*!******************************************************************************
FUNCTION OnShutdown()
*-- Custom message called via the ON SHUTDOWN command to indicate
*-- that the user must exit Tastrade before exiting Visual Foxpro.
=MESSAGEBOX("不能直接退出"+APP_LOC,48,"注意")
ENDFUNC
**************************************************************************
*过程:topy.prg
*用途:将一个中文字符串转换为相应的拼音串
*例:
*  set default to c:\highmis\progs
*  ?topy("中国人民解放军")
*  结果为 ZGRMJFJ
*注:  返回结果为大写
*:******************************************************************************
PROCEDURE TOPY
PARAMETER tcCstr
IF EMPTY(tcCstr)
	RETURN tcCstr
ENDIF
LOCAL i,thisstr,hz,pystr,qw,strlen
thisstr=ALLTRIM(m.tcCstr)
strlen =LEN(m.thisstr)
pystr=""
IF TYPE("_PBSTR_")="U"
	PUBLIC _PBSTR_
	_PBSTR_=REPLICATE("A",36)+;
		REPLICATE("B",196)+;
		REPLICATE("C",245)+;
		REPLICATE("D",196)+;
		REPLICATE("E",28)+;
		REPLICATE("F",131)+;
		REPLICATE("G",161)+;
		REPLICATE("H",193)+;
		REPLICATE("J",319)+;
		REPLICATE("K",106)+;
		REPLICATE("L",260)+;
		REPLICATE("M",163)+;
		REPLICATE("N",87)+;
		REPLICATE("O",8)+;
		REPLICATE("P",128)+;
		REPLICATE("Q",169)+;
		REPLICATE("R",59)+;
		REPLICATE("S",304)+;
		REPLICATE("T",168)+;
		REPLICATE("W",126)+;
		REPLICATE("X",241)+;
		REPLICATE("Y",324)+;
		REPLICATE("Z",341)+SPACE(11)+;
		"CJWGNSPGCGNE Y BTYYZDXYKYGT JNNJQMBSGZSCYJSYY PGKBZGY YWYKGKLJSWKPJQHY W DZLSGMRYPYWWCCKZNKYYG      "+;
		"TTNJJEYKKZYTCJNMCYLQLYPYQFQRPZSLWBTGKJFYXJWZLTBNCXJJJJZXDTTSQZYCDXXHGCK PHFFSS YBGMXLPBYLL HLX      "+;
		"S ZM JHSOJNGHDZQYKLGJHXGQZHXQGKEZZWYSCSCJXYEYXADZPMDSSMZJZQJYZC J WQJBDZBXGZNZCPWHKXHQKMWFBPBY      "+;
		"DTJZZKQHYLYGXFPTYJYYZPSZLFCHMQSHGMXXSXJ  DCSBBQBEFSJYHXWGZKPYLQBGLDLCCTNMAYDDKSSNGYCSGXLYZAYBN      "+;
		"PTSDKDYLHGYMYLCXPY JNDQJWXQXFYYFJLEJPZRXCCQWQQSBZKYMGPLBMJRQCFLNYMYQMSQYRBCJTHZTQFRXQHXMJJCJLX      "+;
		"XGJMSHZKBSWYEMYLTXFSYDSGLYCJQXSJNQBSCTYHBFTDCYZDJWYGHQFRXWCKQKXEBPTLPXJZSRMEBWHJLBJSLYYSMDXLCL      "+;
		"QKXLHXJRZJMFQHXHWYWSBHTRXXGLHQHFNM YKLDYXZPWLGG MTCFPAJJZYLJTYANJGBJPLQGDZYQYAXBKYSECJSZNSLYZH      "+;
		"ZXLZCGHPXZHZNYTDSBCJKDLZZYFMYDLEBBGQYZKXGLDNDNYSKJSHDLYXBCGHXYPKDQMMZMGMMCLGWZSZXZJFZNMLZZTHCS      "+;
		"YDBDLLSCDDNLKJYKJSYCJLKOHQASDKNHCSGZEHDAASHTCPLCPQYBSDMPJLPZJOQLCDHJJYSPRCHN NNLHLYYQYHWZPTCZG      "+;
		"WWMZFFJQQQQYXACLBHKDJXDGMMYDJXZLLSYGXGKJRYWZWYCLZMSSJZLDBYDCPCXYHLXCHYZJQ  QAGMNYXPFRKSSBJLYXY      "+;
		"SYGLNSCMHSWWMNZJJLXXHCHSY  CTXRYCYXBYHCSMXJSZNPWGPXXTAYBGAJCXLY DCCWZOCWKCCSBNHCPDYZNFCYYTYCKX      "+;
		"KYBSQKKYTQQXFCWCHCYKELZQBSQYJQCCLMTHSYWHMKTLKJLYCXWHYQQHTQH PQ QSCFYMMDMGBWHWLGSLLYSDLMLXPTHMJ      "+;
		"HWLJZYHZJXHTXJLHXRSWLWZJCBXMHZQXSDZPMGFCSGLSXYMQSHXPJXWMYQKSMYPLRTHBXFTPMHYXLCHLHLZYLXGSSSSTCL      "+;
		"SLTCLRPBHZHXYYFHB GDNYCNQQWLQHJJ YWJZYEJJDHPBLQXTQKWHLCHQXAGTLXLJXMSL HTZKZJECXJCJNMFBY SFYWYB      "+;
		"JZGNYSDZSQYRSLJPCLPWXSDWEJBJCBCNAYTWGMPABCLYQPCLZXSBNMSGGFNZJJBZSFZYNDXHPLQKZCZWALSBCCJX YZHWK      "+;
		"YPSGXFZFCDKHJGXDLQFSGDSLQWZKXTMHSBGZMJZRGLYJBPMLMSXLZJQSHZYJ ZYDJWBMJKLDDPMJEGXYHYLXHLQYQHKYCW      "+;
		"CJMYYXNATJHYCCXZPCQLBZWWYTWBQCMLPMYRJCCCXFPZNZZLJPLXXYZTZLGDLDCKLYRZZGQTGJHHGJLJAXFGFJZSLCFDQZ      "+;
		"LCLGJDJCSNCLLJPJQDCCLCJXMYZFTSXGCGSBRZXJQQCTZHGYQTJQQLZXJYLYLBCYAMCSTYLPDJBYREGKJZYZHLYSZQLZNW      "+;
		"CZCLLWJQJJJKDGJZOLBBZPPGLGHTGZXYGHZMYCNQSYCYHBHGXKAMTXYXNBSKYZZGJZLQJDFCJXDYGJQJJPMGWGJJJPKQSB      "+;
		"GBMMCJSSCLPQPDXCDYYKY CJDDYYGYWRHJRTGZNYQLDKLJSZZGZQZJGDYKSHPZMTLCPWNJZFYZDJCNMWESCYGLBTZCGMSS      "+;
		"LLYXQSXSBSJSBBSGGHFJLYPMZJNLYYWDQSHZXTYYWHMZYHYWDBXBTLMSYYYFSXJC TXXLHJHF SXZQHFZMZCZTQCXZXRTT      "+;
		"DJHNNYZQQMNQDMMG YTXMJGDHCDYZBFFALLZTDLTFXMXQZDNGWQDBDCZJDXBZGSQQDDJCMBKZFFXMKDMDSYYSZCMLJDSYN      "+;
		"SPRSKMKMPCKLGDCQTFZSWTFGGLYPLLJZHGJ GYPZLTCSMCNBTJBQFKTHBYZGHPBBYMTDSSXTBNPDKLEYCJNYDDYKZTDHQH      "+;
		"SDZSCTARLLTKZLGECLLKJLQJZQNBDKKGHPJTZQKSECSHALQFMMGJNLYJBBTMLYZXDCJPLDLPCQDHZYCBZSCZBZMSLJFLKR      "+;
		"ZJSNFRGJHXPDHYJYBZGDLJCSEZGXLBLHYXTWMABCHECMWYJYZLLJJYHLG DJLSLYGKDZPZXJYYZLWCXSZFGWYYDLYHCLJS      "+;
		"CMBJHBLYZLYCBLYDPDQYSXQZBYTDKYYJY CNRJMPDJGKLCLJBCTBJDDBBLBLCZQRPPXJCGLZCSHLTOLJNMDDDLNGKAQHQH      "+;
		"JHYKHEZNMSHRP QQJCHGMFPRXHJGDYCHGHLYRZQLCYQJNZSQTKQJYMSZSWLCFQQQZYFGGYPTQWLMCRNFKKFSYYLQBMQAMM      "+;
		"MYXCTPSHCPTXXZZSMPHPSHMCLMLDQFYQFSZYJDJJZZHQPDSZGLSTJBCKBXYQZJSGPSXQZQZRQTBDKYXZKHHGFLBCSMDLDG      "+;
		"DZDBLZYYCXNNCSYBZBFGLZZXSWMSCCMQNJQSBDQSJTXXMBLTXZCLZSHZCXRQJGJYLXZFJPHY ZQQYDFQJJLZZNZJCDGZYG      "+;
		"CTXMZYSCTLKPHTXHTLBJXJLXSCDQXCBBTJFQZFSLTJBTKQBXXJJLJCHCZDBZJDCZJDCPRNPQCJPFCZLCLZXZDMXMPHJSGZ      "+;
		"GSZZQLYLWTJPFSYAXMCJBTZYYCWMYTCSJJLQCQLWZMALBXYFBPNLSFHTGJWEJJXXGLLJSTGSHJQLZFKCGNNDSZFDEQFHBS      "+;
		"AQTGYLBXMMYGSZLDYDQMJJRGBJTKGDHGKBLQKBDMBYLXWCXYTTYBKMRTJZXQJBHLMHMJJZMQASLDCYXYQDLQCAFYWYXQHZ"
ENDIF
FOR i = 1 TO m.strlen
	IF ASC(SUBSTR(m.thisstr,m.i,1))>160
		hz=SUBSTR(m.thisstr,m.i,2)
		qw=100 * ASC(LEFT(m.hz,1)) + ASC(RIGHT(m.hz,1)) - 17760
		pystr=IIF(m.qw<1,m.pystr+"V",m.pystr+SUBSTR(_PBSTR_,m.qw,1))
		i=m.i+1
	ELSE
		pystr=m.pystr+SUBSTR(m.thisstr,m.i,1)
	ENDIF
ENDFOR
RETURN m.pystr
*********************************************************
*程序:DOLLAR.PRG
*用途:将数字转换为金额大写
*  例:?Dollar(1234.56)
*     结果:一千二百三十四元五角六分
*注:本程序应以函数方式调用
*限制:本函数只能转换千亿以内的数
*********************************************************
PROCEDURE DOLLAR
LPARAMETER lnAmount
LOCAL lcTempStr, lcString, lcAmount, lnLen, lnCnt, ncnt
lcAmount = LTRIM(TRANSFORM(m.lnAmount,"999999999999.99"))
lnLen = LEN(m.lcAmount)
lcTempStr = ""
FOR lnCnt = m.lnLen TO 1 STEP -1
	lcTempStr = m.lcTempStr + SUBSTR(m.lcAmount,m.lnCnt,1)
ENDFOR
lcAmount = m.lcTempStr
*-- 转换角与分
lcTempStr = SUBSTR(m.lcAmount,2,1)+LEFT(m.lcAmount,1)
IF m.lcTempStr # "00"
	lcString = IIF(SUBSTR(m.lcAmount,2,1)="0" AND m.lnAmount > 1,"零","")+;
		IIF(m.lcTempStr > "09",SUBSTR("一角二角三角四角五角六角七角八角九角",(VAL(LEFT(m.lcTempStr,1))-1)*4+1,4)+;
		Num2Text(VAL(RIGHT(m.lcTempStr,1))),;
		Num2Text(VAL(m.lcTempStr)))+;
		IIF(LEFT(m.lcAmount,1)#"0","分","")
ELSE
	lcString = IIF(m.lnAmount > 0,"整","无金额")
ENDIF

IF m.lnAmount < 1
	RETURN m.lcString
ENDIF

* --  万以内
lcTempStr = ''
ncnt = IIF(m.lnLen < 8,m.lnLen,7)
FOR lnCnt = m.ncnt TO 4 STEP -1
	IF SUBSTR(m.lcAmount,m.lnCnt,1)#"0"
		lcTempStr = IIF(m.lnLen < m.lnCnt + 2 OR SUBSTR(m.lcAmount,m.lnCnt+1,1) # "0",;
			lcTempStr + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-9,2)),;
			lcTempStr + "零" + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-9,2)))
	ENDIF
ENDFOR

lcString = m.lcTempStr + "元" + m.lcString
IF m.lnLen  < 8
	RETURN m.lcString
ENDIF

* -- 亿以内
lcTempStr = ''
ncnt = IIF(m.lnLen < 12,m.lnLen,11)
FOR lnCnt = m.ncnt TO 8 STEP -1
	IF SUBSTR(m.lcAmount,m.lnCnt,1)#"0"
		lcTempStr = IIF(m.lnLen < m.lnCnt + 2 OR SUBSTR(m.lcAmount,m.lnCnt+1,1) # "0",;
			lcTempStr + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-17,2)),;
			lcTempStr + "零" + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-17,2)))
	ENDIF
ENDFOR
lcString = TRIM(m.lcTempStr) + "万" + m.lcString
IF m.lnLen  < 12
	RETURN m.lcString
ENDIF

* -- 千亿以内
lcTempStr = ''
ncnt = IIF(m.lnLen < 16,m.lnLen,15)
FOR lnCnt = m.ncnt TO 12 STEP -1
	IF SUBSTR(m.lcAmount,m.lnCnt,1)#"0"
		lcTempStr = IIF(m.lnLen < m.lnCnt + 2 OR SUBSTR(m.lcAmount,m.lnCnt+1,1) # "0",;
			lcTempStr + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-25,2)),;
			lcTempStr + "零" + Num2Text(VAL(SUBSTR(m.lcAmount,m.lnCnt,1))) + IIF(m.lnCnt = 4,"",SUBSTR("十百千",2 * m.lnCnt-25,2)))
	ENDIF
ENDFOR

IF m.lnLen  > 17
	WAIT WINDOW NOWAIT "只能转换千亿以内的数"
	RETURN ''
ELSE
	RETURN TRIM(m.lcTempStr) + "亿" + lcString
ENDIF
*!******************************************************************************
*!
*! 过程 NUM2TEXT
*!
*!  调用
*!      Num2Text
*!
*!******************************************************************************
FUNCTION Num2Text
LPARAMETER lcDigit
RETURN IIF(m.lcDigit # 0,SUBSTR("一二三四五六七八九",2 * m.lcDigit-1,2),"")
**************************************************************
*过程:ischinese.prg
*用途:判断一个字符串是中文还是英文
*例子:ischines("字符串")  返回.t.
*     ischines("foxpro")  返回.f.
**************************************************************
FUNCTION ischines
PARAMETERS tcStr
LOCAL i
IF EMPTY(m.tcStr)
	RETURN .F.
ENDIF
FOR i = 1 TO LEN(m.tcStr)
	IF ASC(SUBSTR(m.tcStr,i,1))>160
		RETURN .T.
	ENDIF
ENDFOR
RETURN .F.

procedure doerror
LPARAMETERS nError, cMethod, nLine
LOCAL llHandledError,laError[7],lcMessage,lnAnswer

IF THISFORM.lSetErrorOff
	THIS.lHadError = .T.
	RETURN
ENDIF

*-- 装入错误信息
=AERROR(laError)
DO CASE
CASE nError = 1539    && 触发失败
	?? CHR(7)
	*-- 使用表单的属性数组接收错误信息
	=MESSAGEBOX(THISFORM.aErrorMsg[laError[5]],48,APP_LOC)
	*-- 如果删除触发失败,撒消对记录的删除
	IF laError[5] = 3
		THISFORM.RESTORE()
	ENDIF
	llHandledError = .T.
CASE nError = 1583    && 表规则失败
	llHandledError = .T.

CASE nError = 1582    && 字段规则冲突
	?? CHR(7)
	lcMessage = DBGETPROP(ALIAS() + "." + laError[3], "Field", "RuleText")
	lcMessage = STRTRAN(lcMessage, '"', '')
	=MESSAGEBOX(lcMessage,48,APP_LOC)

OTHERWISE
	?? CHR(7)
	lcMessage = MESSAGE() + CHR(13) + ;
		"方法" + cMethod + CHR(13) + ;
		"行号" + ALLT(STR(nLine))
	lnAnswer = MESSAGEBOX(lcMessage,18,"错误")
	DO CASE
	CASE lnAnswer = 3
		oApp.Cleanup
		CANCEL
		RETURN
	CASE lnAnswer = 4
		RETRY
	OTHERWISE
		RETURN
	ENDCASE
ENDCASE

RETURN llHandledError
💿 文件大小 366 K
👤 上传用户 qqpp2q
📂 所属分类教育系统应用
🏷️ 相关标签

#VFP #1.0 #程序 #家
⌨️ 快捷键说明

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