* PROCEDURE _wwtherm * * Use: 1-[O,U] - Message (Default - "") * 2-[O,N] - Current record (Default - RECNO()) * 3-[O,N] - Max number of record (Default - RECCOUNT()) * 4-[O,N] - Bar length in characters (Default - 40) * * Note 2: You can use any of following calls to clear termometer * * _WWTERM("") * _WWTERM(0) * _WWTERM(.F.) * PARAMETERS pcMess, pnCount, pnTotalCount, pnBarLen PRIVATE nBarProc, nProcessed, cDispChar, nParamNum, cTimeMess PRIVATE lUpdateTherm, lShowTime, nSeconds nParamNum = PARAMETERS() IF TYPE("gnWWT_Prc_") = "U" PUBLIC gnWWT_Prc_, gnWWT_Sec_, gnWWT_Lsc_ gnWWT_Prc_ = -1 ENDIF DO CASE CASE Type("pcMess") = "L" and NOT pcMess WAIT CLEAR gnWWT_Prc_ = -1 RELEASE gnWWT_Prc_, gnWWT_Sec_, gnWWT_Lsc_ RETURN CASE nParamNum = 0 pcMess = "" pnCount = RECNO() pnTotalCount = RECCOUNT() pnBarLen = 40 CASE nParamNum = 1 ; AND (TYPE("pcMess") = "L" AND pcMess) ; OR (TYPE("pcMess") = "C" AND EMPTY(pcMess)) gnWWT_Prc_ = -1 PUBLIC gnWWT_Sec_, gnWWT_Lsc_ gnWWT_Sec_ = SECOND() gnWWT_Lsc_ = SECOND() WAIT CLEAR RETURN CASE nParamNum = 1 and EMPTY(pcMess) gnWWT_Prc_ = -1 RELEASE gnWWT_Prc_, gnWWT_Sec_, gnWWT_Lsc_ WAIT CLEAR RETURN CASE nParamNum = 1 pnCount = RECNO() pnTotalCount = RECCOUNT() pnBarLen = 40 CASE nParamNum = 2 pnTotalCount = RECCOUNT() pnBarLen = 40 CASE nParamNum = 3 pnBarLen = 40 ENDCASE IF pnTotalCount = 0 *?? CHR(7) RETURN ENDIF IF pnCount > pnTotalCount * Wrong call. Ignore it RETURN ENDIF cTimeMess = "" nProcessed = CEILING(ABS(pnCount / pnTotalCount)*100) nBarProc = CEILING(pnBarLen * nProcessed/100 * 2) lUpdateTherm = .F. lUpdateTherm = lUpdateTherm OR (gnWWT_Prc_ <> nProcessed) lShowTime = (TYPE("gnWWT_Sec_") = "N" ) IF lShowTime AND NOT lUpdateTherm nSeconds = SECOND() - gnWWT_Lsc_ lUpdateTherm = lUpdateTherm OR (nSeconds > 10 OR nSeconds < 0) ENDIF IF lShowTime AND lUpdateTherm gnWWT_Lsc_ = SECOND() nSeconds = SECONDS() - gnWWT_Sec_ IF nSeconds < 0 nSeconds = nSeconds + 60*60*24 ENDIF IF nSeconds >= 30 cTimeMess = ; " Time Elapsed/Estimated " + ; RIGHT(_Sec2Str(nSeconds, .T.), 7) + " / " + ; RIGHT(_Sec2Str(CEILING(nSeconds/pnCount*pnTotalCount), .T.), 7) + ; CHR(13) ENDIF ELSE cTimeMess = "" ENDIF IF lUpdateTherm pcMess = IIF(TYPE("pcMess") = "C", pcMess,"") IF NOT EMPTY(cTimeMess) ; AND NOT INLIST( RIGHT( TRIM(pcMess),1), ";" , CHR(13) ) pcMess = pcMess + ";" ENDIF pcMess = CHRTRAN(pcMess, ";", CHR(13)) gnWWT_Prc_ = nProcessed cDispChar = IIF( (nBarProc % 2) = 1, CHR(221)," ") nBarProc = INT(nBarProc/2) WAIT CLEAR WAIT WINDOW NOWAIT ; pcMess + ; cTimeMess + ; REPLICATE(CHR(219), nBarProc) + cDispChar + ; REPLICATE(CHR(254),pnBarLen-nBarProc) + STR(nProcessed,4) + "%" ENDIF IF pnCount = pnTotalCount gnWWT_Prc_ = -1 gnWWT_Sec_ = -1 ENDIF RETURN .T.Use
SELECT mytable =_wwtherm("") SCAN _wwtherm("Processing ...;") * Processing code goes here ... ENDSCAN =_wwtherm("")>Hi to all,