Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
VFP code syntax coloring in HTML
Message
 
 
À
18/04/2000 14:16:33
Information générale
Forum:
Visual FoxPro
Catégorie:
Autre
Divers
Thread ID:
00355687
Message ID:
00361015
Vues:
32
>>Can not get it working too :( I tried to
>
>Sorry, thats not realy what I meant. I'm guessing this will work:
>
>lcCode=strtran(chrtran(lcCode, chr(10), ''), chr(13), chr(13) + chr(10))
>
>Anywhere before the Alines()
>
>>Yes, but I'm not 100% sure, that my code does it right in all cases.
>
>I dunno, I haven't looked at your code close enough, but the orginal version never made those changes.

Hi Mike,

I finally made it!!!!!!!! Works like a charm.
********************************************************************
*  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/13/2000 11:02:34 AM
********************************************************************
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'
endif

#define SINGLEQUOTE [']
#define DOUBLEQUOTE ["]
#define LEFTPAR     "["
#define RIGHTPAR    "]"
#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))

*Create an array ouf of our strings.
local laLines[1], lcReturn, lnLines, lnI, lcLine, lnWA

local lcFL, lcComment, lcBeforeComment, lnWords, lcResult

dimension laWords[1]

local lcDoubleAmp, lnStartComment, k, lcLeft, lcRight

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

*     lcFL = ' '+ upper(trim(chrtran(lcBeforeComment, ':;./\<>+=-}]()#', space(15)))) + ' '

*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
          lcBeforeComment=substr(lcLine, 1,lnStartComment-1)
     endif

*!* Devide string into words
     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)
          if lcLeft=LEFTPAR
               lcLeft=RIGHTPAR
          endif

          llStartString=.f.

          if inlist(lcLeft,DOUBLEQUOTE,SINGLEQUOTE,LEFTPAR) && String starts
               llStartString=.t.
               lcSymb=lcLeft
          endif

          do while llStartString
            laWords[k]=chrtran(laWords[k],chr(254),space(1))
               if k<lnWords
                lcLeft=left(laWords[k+1],1)
                lcRight=right(laWords[k+1],1)

                    if lcSymb==lcLeft or lcSymb==lcRight
                    lcSymb=''
                         llStartString=.f. && String ends
                         exit
                    endif

                 lcResult=lcResult+laWords[k]

                    k=k+1 && Increment count

               else
                lcSymb=''
                    llStartString=.f. && String ends
                    exit
               endif
          enddo


          if not empty(laWords[k]) and seek(upper(padr(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))

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
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform