*:******************************************************************************
*:
*: 过程文件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 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
