*:******************************************************************************
*:
*: 过程文件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
*!******************************************************************************
*!
*! 过程 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),"")
