Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Recno() Order
Message
 
 
To
16/11/2000 20:04:02
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Miscellaneous
Thread ID:
00442673
Message ID:
00443003
Views:
12
Hi David,

I believe I mentioned Mike Helland mhHTMLCode (available in Files section) hundreds of time already. Actually, I modified his code a little bit to achieve some additional functionality, but unfortunately, I haven't succeed. I would suggest you to download Mike's code+Words table. Bellow is my own modified version, which I use:
********************************************************************
*  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, '&', '&')
lcCode = strtran(lcCode, '<', '<')
lcCode = strtran(lcCode, '>', '>')
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 = '&&' && 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?
>
>>Bellow is the tecnique I use. One additional note: if your table is ordered don't use just scan... endscan (it would be slower). Either use scan while!eof() endscan or do while!eof()... skip... enddo.
>>
>>
>>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
If it's not broken, fix it until it is.


My Blog
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform