******************************************************************** * Description.......: nnHTMLCode * Calling Samples...: on key label F9 _cliptext=nnHTMLCode(_cliptext) * Parameter List....: lcCode, lcPath, lcBeatify * Created by........: Mike Helland * Modified by.......: Nadya Nosonovsky 04/18/2000 04:45:16 PM ******************************************************************** lparameters lcCode, lcPath, lcBeatify if empty(lcCode) or vartype(lcCode)<>'C' && Check if first parameter exists return .f. endif lnSec=seconds() if vartype(lcBeatify)<>'C' release lcBeatify lcBeatify='M' && Mixed endif if vartype(lcBeatify)='C' and not inlist(left(upper(lcBeatify),1),'U','L') lcBeatify='M' && Mixed endif #define SINGLEQUOTE chr(39) #define DOUBLEQUOTE chr(34) #define LEFTPAR chr(91) #define RIGHTPAR chr(93) #define FONTBLUE '<font color=blue>' #define FONTGREEN '<font color=green>' #define FONTEND '</font>' #define SYMBOLS ':;,./\<>+=-{}[]()#*' *Do some basic HTML intializing lcCode = strtran(lcCode, chr(9), space(5)) lcCode = strtran(lcCode, '&', '&amp;') lcCode = strtran(lcCode, '<', '&lt;') lcCode = strtran(lcCode, '>', '&gt;') lcCode = strtran(lcCode, chr(13), chr(13)+chr(13)) && To proper handle blank lines *Create an array ouf of our strings. local laLines[1], lcReturn, lnLines, lnI, lcLine, lnWA local lcComment, lcBeforeComment, lnWords, lcResult local lcDoubleAmp, lnStartComment, k, lcLeft, lcRight, lcSymb, llStartString lnLines=alines(laLines, lcCode) lcReturn = '<pre>' lnWA=select() if !used('words') use (iif(empty(lcPath), '', lcPath) + 'words') in 0 order tag revword endif *Proccess each line for lnI = 1 to lnLines lcLine = laLines[lnI] *Don't even bother the blank ones if empty(alltrim(lcLine)) lcReturn = lcReturn +chr(13) + chr(10) loop endif *Full Line Comments, first if left(alltrim(lcLine),1) = '*' lcLine = FONTGREEN + lcLine + FONTEND *Print line here lcReturn = lcReturn + chr(13) + chr(10) + lcLine loop endif lcComment='' lcBeforeComment=lcLine *Now end of the line comments lcDoubleAmp = '&amp;&amp;' && This is to test our function lnStartComment = at(lcDoubleAmp, lcLine) if lnStartComment > 0 lcComment = FONTGREEN+substr(lcLine, lnStartComment) + FONTEND && Insert comment tag lcBeforeComment=substr(lcLine, 1,lnStartComment-1) endif *!* Devide string into words dimension laWords[1] lnWords = aparser(@laWords, lcBeforeComment,SYMBOLS) lcResult='' for k=1 to lnWords * First check if we're in a string laWords[k]=chrtran(laWords[k],chr(254),space(1)) lcLeft=left(laWords[k],1) llStartString=.f. if inlist(lcLeft,DOUBLEQUOTE,SINGLEQUOTE,LEFTPAR) && String starts llStartString=.t. if lcLeft=LEFTPAR lcLeft=RIGHTPAR endif lcSymb=lcLeft endif do while llStartString && Check if we're still in string if k<lnWords lcLeft=left(laWords[k+1],1) lcRight=right(alltrim(laWords[k+1]),1) laWords[k]=chrtran(laWords[k],chr(254),space(1)) if lcSymb==lcLeft or lcSymb==lcRight lcSymb='' lcResult=lcResult+laWords[k] k=k+1 llStartString=.f. && String ends exit endif lcResult=lcResult+laWords[k] k=k+1 && Increment count else laWords[k]=chrtran(laWords[k],chr(254),space(1)) lcSymb='' llStartString=.f. && String ends exit endif enddo laWords[k]=chrtran(laWords[k],chr(254),space(1)) if not empty(laWords[k]) and seek(upper(padr(alltrim(laWords[k]),22)),'words','revword') && Word found do case case left(upper(lcBeatify),1)='U' && Upper case laWords[k]=upper(laWords[k]) case left(upper(lcBeatify),1)='L' && Lower case laWords[k]=lower(laWords[k]) endcase laWords[k]=FONTBLUE+laWords[k]+FONTEND endif lcResult=lcResult+laWords[k] next if not empty(lcBeforeComment) and not empty(lcResult) lcBeforeComment=lcResult endif *Submit the process line lcReturn = lcReturn + chr(13) + chr(10) + lcBeforeComment+lcComment && Another In Line Test to use endfor lcReturn = lcReturn + '</pre>' use in words select (lnWA) wait window nowait 'Transformed '+alltrim(str(lnLines))+' lines in '+alltrim(str(seconds()-lnSec,10,6))+' sec' return lcReturn ********************************************************************** function aparser * Description.......: Function parses a text string into an array. * : Each element of the array contains one word... * Calling Samples...: dimension laWords[1] * : lcWordString = "Some text string" * : lnWords = aparser(@laWords, lcWordString) * Parameter List....: paWords, pcWordString, pcDelimiter ******************************************************************** lparameter paWords, pcWordString, pcDelimiter local lnWords, i, lcSymbol external array paWords if vartype(pcDelimiter)<>'C' pcDelimiter=space(1) endif pcWordString=strtran(pcWordString,space(1), space(1)+chr(254)) && Replace space(1) with rare symbol chr(254) for i=1 to len(pcDelimiter) lcSymbol=substr(pcDelimiter,i,1) pcWordString=strtran(pcWordString,lcSymbol,space(1)+lcSymbol+space(1)) && Larry Miller suggested next *!* Replace the delimiter with CHR(13) using STRTRAN. pcWordString = strtran(pcWordString, space(1), chr(13)) *!* Now put each element in an array. lnWords=alines(paWords, pcWordString) return lnWords>PMJI Nadya, but that's an awesome HTML block of code for a simple example:-). Do you hand code that or do you have a tool that formats it for you?
>>local lnSeconds, lnMinutes >> >>local lnReccount, lnRecno, StartTime, prevonesc, prevescape, ; >> msgtail, lnCount, mnend, lcOrder, ; >> lnUpdateNumber, pcMapID, lcAPN, lnBadApn >> >>* note clock reading for generating final timing statistics >>StartTime = seconds() && # seconds since midnight >> >>select BldMstr >> >>lcOrder=order() >>set order to >> >>lnRecno=recno() && Save current record >> >>* support user Escapes for interrupting the main loop >>prevonesc = on('escape') && save previous Escape handler >>prevescape = set('escape') && previous Escape enablement state >>set escape on && enableme escape handling >>halt = .f. && allow loop to run until this flag is toggled >>on escape halt = .t. && force immediate termination if user escapes >>store 0 to lnTally, lnCount, lnBadAPN >> >>lnReccount=reccount() >> >>do case >> case lnReccount&& Very rare case >> lnUpdateNumber=1 >> case between(lnReccount,100,10000) >> lnUpdateNumber=100 >> case lnReccount>10000 >> lnUpdateNumber=val('1'+replicate('0',len(transform(lnReccount))-3)) >>endcase >> >>* assemble fixed portion of status bar message outside of loop, for speed >>msgtail = "/" + transform(lnReccount) + ". Wait or press Esc to cancel ..." >>set message to >>*--- instantiate thermometer bar class.... >>lotherm = newobject("thermometer", "wg","","Progress for APN calculating...",lnReccount) >>lotherm.show() >> >>scan >> lnCount=lnCount+1 >> >>* check for user Escape >> if m.halt && user escaped >> exit && fall out of loop >> endif >> >>** Update thermometr >> if mod(lnCount,lnUpdateNumber) = 0 >> set message to 'Record # '+alltrim(str(lnCount))+m.msgtail >> lotherm.update(lnCount) >> endif>>HTH