www.pudn.com > jq_transfile.ARJ > MISTOOL.PRG
*---------------------------------------------------------------------------
*
* proc: _ActiMenu
* ¹¦ÄÜ: ¼¤»î²Ëµ¥£¬Ìæ´úGUIÖеÄActiMenu()º¯Êý£¬ÒÔÖ§³ÖÈÎÒâ¶à¼¶Ç¶Ì×µ÷ÓÃ
*
*---------------------------------------------------------------------------
proc _ActiMenu
para MenuName
=__SDKSvc1(MenuName)
acti menu &MenuName
return
*---------------------------------------------------------------------------
*
* proc: _ActiPopup
* ¹¦ÄÜ: ¼¤»î²Ëµ¥£¬Ìæ´úGUIÖеÄActiMenu()º¯Êý£¬ÒÔÖ§³ÖÈÎÒâ¶à¼¶Ç¶Ì×µ÷ÓÃ
*
*---------------------------------------------------------------------------
proc _ActiPopup
para PopupName
=__SDKSvc2(PopupName)
acti Popup &PopupName
return
*---------------------------------------------------------------------------
*
* proc: _PullPopup
* ¹¦ÄÜ: ¼¤»î²Ëµ¥£¬Ìæ´úGUIÖеÄActiMenu()º¯Êý£¬ÒÔÖ§³ÖÈÎÒâ¶à¼¶Ç¶Ì×µ÷ÓÃ
*
*---------------------------------------------------------------------------
proc _PullPopup
para PopupName
=__SDKSvc2(PopupName)
acti Popup &PopupName
=DeacPopup(PopupName)
return
*---------------------------------------------------------------------------
*
* proc: _ErrorHandle
* ¹¦ÄÜ: SDKÌṩµÄerror´¦Àí¹¤¾ß
*
*---------------------------------------------------------------------------
proc _ErrorHandle
priv pnArea,pnR1,pnC1,pnColor,pnOp,pcEnglish,pcChinese,pcParm,pnMaxLen
pcEnglish=mess()
pnArea=sele(0)
sele 0
use _Error orde ERRORNO
if seek(erro())
pcChinese=Chinese
if at(chr(39)+chr(39),pcChinese)!=0
if occu(chr(39),pcEnglish)=2
pcParm=subs(pcEnglish,at(chr(39),pcEnglish),;
at(chr(39),pcEnglish,2)-at(chr(39),pcEnglish)+1)
pcChinese=strtran(pcChinese,chr(39)+chr(39),pcParm)
endi
endi
else
pcChinese=''
endi
use
sele (pnArea)
pnMaxLen=max(len(rtri(pcEnglish)),len(rtri(pcChinese)),26)
pnR1=srows()/2-6
pnC1=(scol()-pnMaxLen-22)/2
pnR2=pnR1+9
pnC2=pnC1+22+pnMaxLen
pcColor='N/W,B/W,BG/W,W+/GR,N+/W,W+/GR,R/W,N+/N,N/W,N/W'
=DefiWind('_ErrHandle',pnR1,pnC1,pnR2,pnC2,"colo &pcColor titl '³ÌÐòÔËÐдíÎó'")
=ActiWind('_ErrHandle')
=GrpRect(1,1,wrow(),wcol()-2)
=ShowIco(C2X(3),R2Y(2)+8,'_Stop')
@2,8 say "´íÎóºÅ : "+ltri(str(erro()))
@3,8 say "Ó¢ÎÄÐÅÏ¢: "+pcEnglish
@4,8 say "ÖÐÎÄÐÅÏ¢: "+pcChinese
?? chr(7)
pnOp=1
if !rdle()=0
show gets disa leve rdle()
endi
=GetCtrl(6,(pnC2-pnC1-38)/2,10,3,"pnOp","func '*H \19,19,P_R1))
P_C1=iif(P_C1<1,1,iif(P_C1>54,54,P_C1))
P_Color='N/W,B/W,BG/W,W+/GR,N+/W,W+/GR,R/W,N+/N,N/W,N/W'
=DefiWind('_ReadErr',P_R1,P_C1,P_R1+5,P_C1+25,"colo &P_Color titl '×¢Òâ'")
=ActiWind('_ReadErr')
=ShowIco(C2X(2),R2Y(1)+10,'_Warn')
@2,7 say "ÊäÈëÊý¾Ý²»ºÏ·¨!"
?? chr(7)
wait ''
=ReleWind('_ReadErr')
retu
*---------------------------------------------------------------------------
*
* proc: _MsgBox
* ¹¦ÄÜ: SDKÌṩµÄÐÅÏ¢ÏÔʾÆ÷
*
*---------------------------------------------------------------------------
proc _MsgBox
para tcMsg,tcIcon,tcTitle,tcColor
priv pnI,pnLen,pnLines,pnMaxLen
tcIcon =iif(type("tcIcon") !="C","_Info" ,tcIcon)
tcTitle=iif(type("tcTitle")!="C","×¢ Òâ",tcTitle)
tcMsg="\n"+tcMsg+"\n"
pnLines=occu("\n",tcMsg)-1
pnMaxLen=0
for pnI=1 to pnLines
pnLen=len(subs(tcMsg,at('\n',tcMsg,pnI), ;
at('\n',tcMsg,pnI+1)-at('\n',tcMsg,pnI)))
if pnMaxLen0;
orde by RSCSEQ asc into arra pcFltFld
sele (pnArea)
if _TALLY=0
pJ=0
for pI=1 to fcoun()
pCurFld=field(pI)
if !pCurFld=="SELMARK" and !at(type(pCurFld),"CND")=0
pJ=pJ+1
endi
endf
if pJ=0
retu .t.
endi
dime pcFltFld[pJ,2]
pJ=1
for pI=1 to fcoun()
pCurFld=field(pI)
if !pCurFld=="SELMARK" and !at(type(pCurFld),"CND")=0
pcFltFld[pJ,1]=pCurFld
pcFltFld[pJ,2]=ChnField(pCurFld)
pJ=pJ+1
endi
endf
endi
priv pnFltSelOp,pnFldSel
pcColor='B/W,W+/B,W/W,W+/B,W/B,W+/B,W+/W,W/B,N/W,N+/W'
=DefiWind("FLTFLDSEL",1,13,22,65,"colo &pcColor titl 'ÇëÑ¡ÔñÊý¾Ý·¶Î§'")
defi popu FLTFLDSEL scro in wind FLTFLDSEL mark 'û'
defi bar 1 of FLTFLDSEL prom " \100
set filt to SELMARK=="*"
go top
retu .t.
else
repl all SelMark with chr(asc(SelMark)-101) for asc(SelMark)>100
set filt to &pcCurFlt
go pnRecn
retu .f.
endi
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: FltFldSel ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func FltFldSel
priv pcCurFld,pcCurFldChn,pcCurFldType
if pnFldSel=1
repl all SelMark with chr(asc(SelMark)+101) for asc(SelMark)<100
retu .t.
endi
pcCurFld=rtri(pcFltFld[pnFldSel-1,1])
pcCurFldType=type(pcCurFld)
pcCurFldChn=rtri(pcFltFld[pnFldSel-1,2])
pcColor='B/W,B/W,W/W,W+/B,W/B,W+/B,W+/W,W/B,N/W,N+/W'
=DefiWind("FLTRECSEL",1,11,22,67,"colo &pcColor titl 'ÇëÑ¡Ôñ"+pcCurFldChn+"·¶Î§'")
=ActiWind("FLTRECSEL")
do case
case pcCurFldType='C'
do CRECSEL
case pcCurFldType='N'
do NRECSEL
case pcCurFldType='D'
do DRECSEL
endc
=ReleWind("FLTRECSEL")
retu .t.
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: CRecSel ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func CRecSel
priv pnOpSel,pnLen,pcArea,pnArea,pcListDBF,pcOrdSave
pcListDBF=sys(3)
pnArea=sele(0)
sele dist &pcCurFld, ' ' as SelMark from (pcCurDBF) where asc(SelMark)>100 into table &pcListDBF
PROMFLD="' '+SELMARK+"+pcCurFld
defi popu FLTRECSEL from 0,0 to wrow('FLTFLDSEL')-9,wcol('FLTFLDSEL')-22-7;
prom fiel &PROMFLD scro mark ''
pcListAlias=alias()
FLTRECSEL=1
pnOpSel=1
CFLDIN=repl(' ',fsize(pcCurFld))
=GrpRect(1,1,wrow('FLTRECSEL'),wcol('FLTRECSEL')-1)
@2,4 say pcCurFldChn
pnLen=len(pcCurFldChn)
=Get(2,6+pnLen,"CFLDIN","size 1,"+ltri(str(30-(pnLen)))+"vali CRecInChk()")
=GetCtrl(4,4,wrow('FLTRECSEL')-4,33,"FLTRECSEL","func '&' popu FLTRECSEL;
when CFLDIN='' vali SELREC();
colo N/W*,N/W*,W/W,W+/B,N/W,W+/B,B/W,W/B,N/W,W+/W")
=GetCtrl(7,41,9,4,'pnOpSel',"func '*V \100
sele (pcListAlias)
ends
sele (pnArea)
repl all SELMARK with chr(asc(SELMARK)-101) for asc(SELMARK)>100
set orde to &pcOrdSave
endi
use in (pcListAlias)
pcListDBF=pcListDBF+".DBF"
dele file (pcListDBF)
retu
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: SelRec ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func SelRec
if Varr()=="FLTRECSEL"
repl SELMARK with iif(SELMARK=='*','','*')
keyb "{DNARROW}"
else
keyb chr(last()) plain
endi
retu .t.
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: CRecInChk ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func CRecInChk
if ltri(CFLDIN)==""
retu .t.
endi
loca for rtri(&pcCurFld)==rtri(CFldIn)
if foun()
FltRecSel=recn()
=SELREC()
endi
CFldIn=repl(' ',fsize(pcCurFld))
if eof()
retu .f.
endi
show get FLTRECSEL
retu .t.
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: NRecSel ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func NRecSel
priv LowLmt,UpLmt,FlagUpIn,FlagLowIn,pnOpSel,pcFiltExp
LowLmt=repl(' ',21)
UpLmt=repl(' ',21)
FlagUpIn=1
FlagLowIn=1
pnOpSel=1
=GrpRect(1.5,4,7.5,wcol('FLTRECSEL')-4," ÇëÊäÈëÊý¾Ý·¶Î§ ")
=GrpRect(13.5,4,19.5,wcol('FLTRECSEL')-4," ÇëÑ¡ÔñÊÇ·ñ°üÀ¨±ß½çÖµ")
@3,8 say '×îСֵ:'
@5,8 say '×î´óÖµ:'
do whil .t.
=Get(3,18,"LowLmt","size 1,28 vali ISNUM(LowLmt)")
=Get(5,18,"UpLmt", "size 1,28 vali ISNUM(UpLmt)")
=GetCtrl(10,10,15,4,'pnOpSel',"func '*H \'+iif(FlagLowIn=1,'=','')+LowLmt
case LowLmt=='' .and. !UpLmt==''
pcFiltExp=pcCurFld+'<'+iif(FlagUpIn=1,'=','')+UpLmt
case !LowLmt=='' .and. !UpLmt==''
if val(LowLmt)<=val(UpLmt)
pcFiltExp=pcCurFld+'>'+iif(FlagLowIn=1,'=','')+LowLmt+' .and. ';
+pcCurFld+'<'+iif(FlagUpIn=1,'=','')+UpLmt
else
pcFiltExp=pcCurFld+'>'+iif(FlagLowIn=1,'=','')+LowLmt+' .or. ';
+pcCurFld+'<'+iif(FlagUpIn=1,'=','')+UpLmt
endi
endc
repl all SelMark with chr(asc(SelMark)-101);
for asc(SelMark)>100 and not (&pcFiltExp)
endi
retu
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: DRecSel ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func DRecSel
priv LowLmt,UpLmt,FlagUpIn,FlagLowIn,pnOpSel,pcFiltExp
LowLmt=' / / '
UpLmt= ' / / '
FlagUpIn=1
FlagLowIn=1
pnOpSel=1
=GrpRect(1.5,4,7.5,wcol('FLTRECSEL')-4," ÇëÊäÈëÊý¾Ý·¶Î§ ")
=GrpRect(13.5,4,19.5,wcol('FLTRECSEL')-4," ÇëÑ¡ÔñÊÇ·ñ°üÀ¨±ß½çÖµ")
@3,10 say 'ÆðʼÈÕÆÚ(ÔÂ/ÈÕ/Äê)'
@5,10 say '½ØÖ¹ÈÕÆÚ(ÔÂ/ÈÕ/Äê)'
do whil .t.
=Get(3,30,"LowLmt","pict '99/99/9999'")
=Get(5,30,"UpLmt", "pict '99/99/9999'")
=GetCtrl(10,10,15,4,'pnOpSel',"func '*H \'+iif(FlagLowIn=1,'=','')+'{'+LowLmt+'}'
case allt(LowLmt)#'/ /' .and. allt(UpLmt)#'/ /'
if ctod(LowLmt)<=ctod(UpLmt)
pcFiltExp=pcCurFld+'>'+iif(FlagLowIn=1,'=','')+'{'+LowLmt+'}';
+' .and. '+pcCurFld+'<'+iif(FlagUpIn=1,'=','')+'{'+UpLmt+'}'
else
pcFiltExp=pcCurFld+'>'+iif(FlagLowIn=1,'=','')+'{'+LowLmt+'}';
+' .or. '+pcCurFld+'<'+iif(FlagUpIn=1,'=','')+'{'+UpLmt+'}'
endi
endc
repl all SelMark with chr(asc(SelMark)-101);
for asc(SelMark)>100 and not (&pcFiltExp)
endi
retu
*ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
*º º
*º Function: _Orde º
*º Desciptaion: SDKÌṩµÄͨÓÃÊý¾ÝÅÅÐò¹¤¾ß º
*º º
*ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
func _Orde
priv all like p*
pnArea=sele(0)
pcCurDBF=CurDBF()
pnRecn=recn()
pcCurOrd=set("ORDE")
set orde to
sele SDKRSC
sele RscName,RscTitle from SDKRSC where RSCTYPE=="INDEX" and BELONGTO==pcCurDBF and RSCSEQ>0;
orde by RSCSEQ asc into arra pcOrdFld
sele (pnArea)
if _TALLY=0
pJ=0
for pI=1 to fcoun()
pCurFld=field(pI)
if !pCurFld=="SELMARK" and !at(type(pCurFld),"CND")=0
pJ=pJ+1
endi
endf
if pJ=0
retu .t.
endi
dime pcOrdFld[pJ,2]
pJ=1
for pI=1 to fcoun()
pCurFld=field(pI)
if !pCurFld=="SELMARK" and !at(type(pCurFld),"CND")=0
pcOrdFld[pJ,1]=pCurFld
pcOrdFld[pJ,2]=ChnField(pCurFld)
pJ=pJ+1
endi
endf
endi
priv pnOrdSelOp,pnFldSel
pcColor='B/W,W+/B,W/W,W+/B,W/B,W+/B,W+/W,W/B,N/W,N+/W'
=DefiWind("ORDFLDSEL",1,13,22,65,"colo &pcColor titl 'ÇëÑ¡ÔñÅÅÐò×ֶλòÃû³Æ'")
defi popu ORDFLDSEL scro in wind ORDFLDSEL mark 'û'
defi bar 1 of ORDFLDSEL prom " \0
retu (!ascan(pFldAry,uppe(FieldName))=0)
endi
retu .f.
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: ExistTag ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func ExistTag
para VTAGNAME
priv TAGNO
TAGNO=1
do whil .t.
if tag(TAGNO)==""
retu .f.
else
if tag(TAGNO)=uppe(VTAGNAME)
retu .t.
endi
endi
TAGNO=TAGNO+1
endd
*ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
*³ Function: IsNum ³
*³ Description: ÄÚ²¿º¯Êý ³
*ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
func ISNUM
para VST
priv FLAGNUM,FLAGPOINT
VST=allt(VST)
if VST==''
retu .t.
endi
stor .t. to FLAGNUM,FLAGPOINT
for CNTOR=1 to len(VST)
if !isdi(subs(VST,CNTOR,1))
if subs(VST,CNTOR,1)=='.' .and. FLAGPOINT
FLAGPOINT=.f.
else
if !(subs(VST,CNTOR,1)$'+-' .and. CNTOR=1)
FLAGNUM=.f.
exit
endi
endi
endi
endf
retu FLAGNUM
*ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
*º º
*º Function: _SysInfo º
*º Desciptaion: SDKÌṩµÄϵͳÐÅÏ¢ÏÔʾ¹¤¾ß º
*º º
*ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
func _SysInfo
priv all like p*
if wexi('SysInfo')
retu
endi
=DefiWind('SysInfo',3,16,18,63,"colo n/w,,,w+/b titl 'ϵ ͳ ЊϢ'")
=Actiwind("SysInfo")
=DnRect(C2X(1),R2Y(1),C2X(wcol("SysInfo")-1),R2Y(wrow("SysInfo")))
=UpRect(C2X(1)+1,R2Y(1)+1,C2X(wcol("SysInfo")-1)-1,R2Y(wrow("SysInfo"))-1)
@3,5 say " CPUÀàÐÍ: "
@4,5 say " ÏÔʾÆ÷ÀàÐÍ: "
@5,5 say " ²Ù×÷ϵͳ: "
@6,5 say " Ê£ÓàÄÚ´æ: "
@7,5 say " ¿ÉÓÃEMS: "
@8,5 say " ´ÅÅÌ×ÜÈÝÁ¿: "
@9,5 say " Ê£Óà´ÅÅÌÈÝÁ¿:"
@10,5 say " µ±Ç°Â·¾¶ "
@11,5 say " ϵͳÈÕÆÚ: "
@12,5 say " ´òÓ¡»ú״̬: "
@3,20 say sys(17) colo b/w
@4,20 say sys(2006) colo b/w
@5,20 say os() colo b/w
@6,20 say ltri(tran(val(sys(12)),"999,999,999,999"))+" Bytes" colo b/w
@7,20 say ltri(tran(val(sys(23)),"999,999,999,999"))+" Bytes" colo b/w
@8,20 say ltri(tran(val(sys(2020)),"999,999,999,999"))+" Bytes" colo b/w
@9,20 say ltri(tran(disk(),"999,999,999,999"))+" Bytes" colo b/w
@10,20 say sys(5)+sys(2003) colo b/w
@11,20 say ltri(str(year(date())))+"Äê"+ltri(str(mont(date())))+"ÔÂ"+ltri(str(day(date())))+"ÈÕ"+;
"£¨ÐÇÆÚ"+subs("ÈÕÒ»¶þÈýËÄÎåÁù",(dow(date())-1)*2+1,2)+"£©" colo b/w
if prin()
@12,20 say "¾ÍÐ÷" colo b/w
else
@12,20 say "δ¾ÍÐ÷" colo b/w
endi
pcCursor=set("curs")
set curs off
wait ''
set curs &pcCursor
=ReleWind("SysInfo")
retu
*---------------------------------------------------------------------------
*
* proc: _OutReport
* ¹¦ÄÜ: SDKÌṩµÄ±¨±í´¦Àí¹¤¾ß
*
*---------------------------------------------------------------------------
proc _OutReport
para VRPTFILE,VRPTCHN
priv RPTTXT,COPYNUM,OutTgt
priv all like P_*
if !type("VRPTFILE")=='C'
retu
endi
if !type("VRPTCHN")='C'
VRPTCHN=VRPTFILE
endi
COPYNUM=1
OutTgt=GetOutTgt()
if OutTgt==''
retu .f.
endi
if OutTgt=='PRN'
if .not. CHKPRN()
retu .f.
endi
endi
P_Color='B/W,W+/W,BG/W,W+/B,W/B,W+/B,GR/W,W/B,N/W,W+/W'
=DefiWind('_PrePareRpt',6,22,12,56,"colo &P_Color Titl 'Éú³É±¨±í'")
=ActiWind('_PrePareRpt')
@2,10 say 'ÕýÔÚÉú³É±¨±í'
@3,10 say ' ÇëÉÔºò! '
RPTTXT=sys(2015)+'.TMP'
set cons off
set devi to prin
set prin to NUL
set prin on
ejec
set prin to file (RPTTXT)
if file(VRPTFILE+".FRT")
repo form (VRPTFILE) envi noco noej to prin
else
do (VRPTFILE)
endi
*set prin to PRN
set prin to TTT
set prin off
set devi to scre
set cons on
=ReleWind('_PrePareRpt')
do case
case OutTgt=='PRN'
do PRNRPT
dele file (RPTTXT)
case OutTgt=='SCR'
do VIEWRPT
dele file (RPTTXT)
othe
dele file &OutTgt
rena (RPTTXT) to (OutTgt)
endc
retu .t.
*!*****************************************************************************
*!
*! Function: GetOutTgt()
*!
*!*****************************************************************************
func GetOutTgt
priv P_Color,FinSel,TgtSel,FileTgt,Cursor
P_Color='B/W,W+/W,BG/W,W+/B,W/B,W+/B,GR/W,W/B,N/W,W+/W'
=DefiWind('PrnSet',5,8,16,71,"colo &P_Color titl '±¨±íÊä³ö·½Ê½É趨'")
=ActiWind('PrnSet')
FinSel=1
TgtSel=1
CopyNum=1
FileTgt=repl(' ',128)
Cursor=set("curs")
=GrpRect(1.5,1,9.5,42,'Ä¿±êÑ¡Ôñ')
=GrpRect(1.5,43,3.5,60)
=ShowIco(C2X(4),R2Y(2)+8,'ToPrn.ICO')
=ShowIco(C2X(4),R2Y(4)+8,'ToScr.ICO')
=ShowIco(C2X(4),R2Y(6)+8,'ToFld.ICO')
@2,45 say "´òÓ¡·ÝÊý"
set curs on
do whil .t.
=GetCtrl(5,45,13,2,"FinSel","func '*V \0
KEY_TMP=uppe(chr(I))
if I=13
KEY_TMP="="
endi
do case
case I=151
do CALBT_MS
case KEY_TMP $ "1234567890.CSEN+-*/=" .or. I=127
do CALBT_KEY
case KEY_TMP $ "M"
do M_FUNC
endc
endi
endd
=ReleWind('_Calculator')
set curs &pcCursor
retu
func EnhanceM
priv all like P_*
for P_Counter=1 to pnButtNum
if CALBUTT(P_Counter,6)=='M'
@CALBUTT(P_Counter,2),CALBUTT(P_Counter,3) say rtri(CALBUTT(P_Counter,5)) colo GR/W
endi
endf
retu
func NormalM
priv all like P_*
for P_Counter=1 to pnButtNum
if CALBUTT(P_Counter,6)=='M'
@CALBUTT(P_Counter,2),CALBUTT(P_Counter,3) say rtri(CALBUTT(P_Counter,5))
endi
endf
retu
*!*****************************************************************************
*!
*! Procedure: M_FUNC
*!
*! Called by: CALCULATOR (procedure in MAINPROC.PRG)
*!
*! Calls: CALBT_KEY (procedure in MAINPROC.PRG)
*!
*!*****************************************************************************
proc M_FUNC
if wrow("_Calculator")>11
=EnhanceM()
endi
I=inke(0,"H")
if wrow("_Calculator")>11
=NormalM()
endi
do case
case I=43
KEY_TMP='W'
case I=45
KEY_TMP='X'
case I=82 .or. I=114
KEY_TMP='Y'
case I=67 .or. I=99
KEY_TMP='Z'
othe
retu
endc
do CALBT_KEY
retu
*!*****************************************************************************
*!
*! Procedure: CALBT_MS
*!
*! Called by: CALCULATOR (procedure in MAINPROC.PRG)
*!
*! Calls: =MSEVENT() (procedure in MAINPROC.PRG)
*! : CALBT_KEY (procedure in MAINPROC.PRG)
*!
*!*****************************************************************************
proc CALBT_MS
priv CNTOR
for CNTOR=1 to pnButtNum
if mrow()=CALBUTT(CNTOR,2);
.and. mcol()>=CALBUTT(CNTOR,3);
.and. mcol()=1 .and. left(KEY_BUFF,1) = "0"
KEY_BUFF=righ(KEY_BUFF,len(KEY_BUFF)-1)
endi
endi
SIGN_FLAG=.f.
if val(KEY_BUFF)<0.1E17 .and. val(KEY_BUFF)>-0.1E17
@1,6 say KEY_BUFF pict "@J "+repl("X",20) colo b/bg
else
@1,6 say str(val(KEY_BUFF)) pict "@J "+repl("X",20) colo b/bg
endi
*************CASE***************
case I=127 && Backspace
if SIGN_FLAG=.f.
if len(KEY_BUFF) # 1
KEY_BUFF=left(KEY_BUFF,len(KEY_BUFF)-1)
else
if KEY_BUFF # "0"
KEY_BUFF="0"
endi
endi
endi
@1,6 say KEY_BUFF pict "@J "+repl("X",20) colo b/bg
retu
case KEY_TMP $ "+-*/=" .or. KEY_TMP=chr(13)
@1,3 say BIGSIGN(KEY_TMP) colo w+/gr
END_TMPS=righ(CAL_BUFF,2)
END_TMP1=left(END_TMPS,1)
END_TMP2=righ(END_TMPS,1)
***********DIVIIDE BY ZERO ???********
if END_TMP2="/" .and. (SIGN_FLAG=.f.) .and. val(KEY_BUFF)=0
do CalWarn with "ÑÏÖØ´íÎó: ³ýÊýΪÁã! "
retu
endi
***********INPUT A SIGN
******INPUT 2 OR MORE SIGNS
if SIGN_FLAG = .t.
if (KEY_TMP $ "*/=" .and. END_TMP2 $ "+-*/=") .or. END_TMP1 $ "+-*/=" .or. END_TMP2="="
CAL_BUFF=left(CAL_BUFF,len(CAL_BUFF)-1)
if KEY_TMP $ "*/=" .and. righ(CAL_BUFF,1) $ "+-*/="
CAL_BUFF=left(CAL_BUFF,len(CAL_BUFF)-1)
endi
endi
else
CAL_BUFF=CAL_BUFF+KEY_BUFF
CAL_BUFF=str(&CAL_BUFF,15,14)
do whil righ(CAL_BUFF,1)="0"
CAL_BUFF=left(CAL_BUFF,len(CAL_BUFF)-1)
endd
if val(CAL_BUFF)=0
CAL_BUFF="0"
endi
@1,6 say CAL_BUFF pict "@J "+repl("X",20) colo b/bg
endi
SIGN_FLAG=.t.
KEY_BUFF="0"
CAL_BUFF=CAL_BUFF+KEY_TMP
case KEY_TMP="W"
if SIGN_FLAG=.f.
M_BUFF=M_BUFF+val(KEY_BUFF)
else
M_BUFF=M_BUFF+val(CAL_BUFF)
endi
M_FLAG=.t.
case KEY_TMP="X"
if SIGN_FLAG=.f.
M_BUFF=M_BUFF-val(KEY_BUFF)
else
M_BUFF=M_BUFF-val(CAL_BUFF)
endi
M_FLAG=.t.
case KEY_TMP="Y"
M_FLAG=.t.
SIGN_FLAG=.f.
if righ(CAL_BUFF,1)="="
CAL_BUFF="0"
endi
KEY_BUFF=str(M_BUFF,15,14) &&& USE KEY_BUFF TO HOLD M_BUFF
do whil righ(KEY_BUFF,1)="0"
KEY_BUFF=left(KEY_BUFF,len(KEY_BUFF)-1)
endd
if val(KEY_BUFF)=0
KEY_BUFF="0"
endi
@1,6 say KEY_BUFF pict "@J "+repl("X",20) colo w+/gr
M_BUFF=val(KEY_BUFF)
case KEY_TMP="Z"
M_BUFF=0
M_FLAG=.t.
case KEY_TMP="S"
if (SIGN_FLAG=.f. .and. val(KEY_BUFF)<0) .or. (SIGN_FLAG=.t. .and. val(CAL_BUFF)<0)
do CalWarn with "ÑÏÖØ´íÎó: ²»ÄܽøÐи´ÊýÔËËã!"
retu
endi
if SIGN_FLAG=.t. .and. righ(CAL_BUFF,1)$"+-*/"
do CalWarn with "ÑÏÖØ´íÎó: ÔËËã·ûÐòÁв»ºÏ¹æÔò!"
retu
endi
if SIGN_FLAG=.f.
CAL_BUFF=str(sqrt(val(KEY_BUFF)),15,14)
else
CAL_BUFF=str(sqrt(val(CAL_BUFF)),15,14)
endi
do whil righ(CAL_BUFF,1)="0"
CAL_BUFF=left(CAL_BUFF,len(CAL_BUFF)-1)
endd
if val(CAL_BUFF)=0
CAL_BUFF="0"
endi
@1,6 say CAL_BUFF pict "@J "+repl("X",20) colo w+/gr
CAL_BUFF=CAL_BUFF+'='
SIGN_FLAG=.t.
M_FLAG=.t.
case KEY_TMP="N"
if (SIGN_FLAG=.f. .and. val(KEY_BUFF )=0) .or. (SIGN_FLAG=.t. .and. val(CAL_BUFF)=0)
retu
endi
if SIGN_FLAG=.t. .and. righ(CAL_BUFF,1)$"+-*/"
do CalWarn with "ÑÏÖØ´íÎó: ÔËËã·ûÐòÁв»ºÏ¹æÔò!"
retu
endi
if SIGN_FLAG
if val(CAL_BUFF)>0
CAL_BUFF="-"+CAL_BUFF
else
CAL_BUFF=righ(CAL_BUFF,len(CAL_BUFF)-1)
endi
else
if val(KEY_BUFF)>0
CAL_BUFF="-"+KEY_BUFF
else
CAL_BUFF=righ(KEY_BUFF,len(KEY_BUFF)-1)
endi
endi
do whil righ(CAL_BUFF,1)="0"
CAL_BUFF=left(CAL_BUFF,len(KEY_BUFF)-1)
endd
if val(CAL_BUFF)=0
CAL_BUFF="0"
endi
@1,6 say CAL_BUFF pict "@J "+repl("X",20) colo w+/gr
CAL_BUFF=CAL_BUFF+'='
SIGN_FLAG=.t.
M_FLAG=.t.
case KEY_TMP="E"
if SIGN_FLAG=.t. .and. righ(CAL_BUFF,1)$"+-*/"
do CalWarn with "ÑÏÖØ´íÎó: ÔËËã·ûÐòÁв»ºÏ¹æÔò!"
retu
endi
if SIGN_FLAG=.f.
CAL_BUFF=str(exp(val(KEY_BUFF)),15,14)
else
CAL_BUFF=str(exp(val(CAL_BUFF)),15,14)
endi
do whil righ(CAL_BUFF,1)="0"
CAL_BUFF=left(CAL_BUFF,len(KEY_BUFF)-1)
endd
if val(CAL_BUFF)=0
CAL_BUFF="0"
endi
@1,6 say CAL_BUFF pict "@J "+repl("X",20) colo w+/gr
CAL_BUFF=CAL_BUFF+'='
SIGN_FLAG=.t.
M_FLAG=.t.
endc
if M_BUFF # 0
@1,1 say "M" colo w+/gr
else
@1,1 say " " colo b/bg
endi
retu
**************
proc UpCalBtn
para tnNo
@CalButt(tnNo,2),CalButt(tnNo,3) say rtri(CalButt(tnNo,5))
=UpRect(C2X(CalButt(tnNo,3))-5,R2Y(CalButt(tnNo,2))-6,;
C2X(CalButt(tnNo,3)+CalButt(tnNo,4))+4,R2Y(CalButt(tnNo,2)+1)+5)
retu
*************
proc HoldKey
priv pnNo
do while mdown()
endd
retu
*************
proc PUSHCALBT
para VKEY
priv pnNo
for pnNo=1 to pnButtNum
if CalButt(pnNo,1)=VKEY
exit
endi
endf
=DnRect(C2X(CalButt(pnNo,3))-5,R2Y(CalButt(pnNo,2))-6,;
C2X(CalButt(pnNo,3)+CalButt(pnNo,4))+4,R2Y(CalButt(pnNo,2)+1)+5)
=HoldKey()
=UpRect(C2X(CalButt(pnNo,3))-5,R2Y(CalButt(pnNo,2))-6,;
C2X(CalButt(pnNo,3)+CalButt(pnNo,4))+4,R2Y(CalButt(pnNo,2)+1)+5)
retu
proc CalWarn
para ERRMSG
priv all like P_*
do _Warn in MisTool with ERRMSG
CAL_BUFF="0"
KEY_BUFF="0"
SIGN_FLAG=.t.
@1,3 say " " colo b/bg
@1,6 say 0 pict repl("9",20) colo b/bg
retu
func BIGSIGN
para VSIGN
do case
case VSIGN=='+'
retu '£«'
case VSIGN=='-'
retu '£'
case VSIGN=='*'
retu '¡Á'
case VSIGN=='/'
retu '¡Â'
case VSIGN=='='
retu '£½'
othe
retu ' '
endc
*End of calculator
********************