Fast Syntax Highlighter - Borje

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'Credit: Borje Hagsten
http://www.powerbasic.com/support/pbforums/showthread.php?t=23591&highlight=text+rich+edit+control
 
'Compiler Comments:
'To compile with PBWin9, pass rc rather than VarPTR(rc) in MapWIndowPoints API
 
'Compilable Example:
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Fast RichEdit syntax color code viewer for PB code (BAS, INC, RC, etc)
' Public Domain by Borje Hagsten, November 2002
' Written for PB/WIN 7.0, but should compile fine in version 6.x too
'
' Completely free to use and enhance - at own responsibility, of course.
' Save file as something like "PBtoRTF.bas" (whatever), compile and run.
''
' This code + compiled exe also available for download from:
' http://www.tolkenxp.com/pb/codeview.zip  (~36 KB)
'
' Update Nov 19: fixed a mistake with ASM keyword. Also added special endblock
' for PB keywords to enable size trim if two keywords follows each other.
' RichEdit's speed depends on size of text, so must try to keep it down.
'
' Update Nov 18: Changed NewEvents macro to SUB, since it contains a
' local declare. Since macros become inline code, that would mean error
' if it is used more than one time in same routine. Also changed from
' using WM_SETTEXT to proper RichEdit stream in procedure. For best speed,
' I added global text buffer and some global variables for streaming proc,
' and changed SyntaxColorBAS and SyntaxColorRC to SUB's instead.
'
' Note: RichEditViewCode parser is very fast - RichEdit is not.
' Even +100 KB files are parsed in less than a second, but RichEdit
' can need many seconds to load them. MB files means long vacation..
' Hopefully, some day MS will buy a copy of PB and learn how to write
' tighter, faster code for RichEdit..        
'
' Tip: For color printouts, press Ctrl+A to select all, Ctrl+C to copy,
' paste into WordPad (whatever) and print.
'------------------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#INCLUDE "COMDLG32.INC"
#INCLUDE "RICHEDIT.INC"
'------------------------------------------------------------------------------
%IDC_LABEL   = 10
%IDC_OPEN    = 20
%ID_RICHEDIT = 50
'------------------------------------------------------------------------------
GLOBAL aStart() AS LONG, aCount() AS LONG
GLOBAL gPos AS LONG, gPtr AS LONG, gTxt AS STRING
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION DlgProc() AS LONG
DECLARE FUNCTION LoadPBdata(dArray() AS STRINGAS LONG
DECLARE FUNCTION LoadHTMLdata(dArray() AS STRINGAS LONG
DECLARE FUNCTION LoadRCdata(dArray() AS STRINGAS LONG
DECLARE FUNCTION RichEditViewCode (BYVAL hRichEdit AS LONG, BYVAL fName AS STRINGAS LONG
DECLARE FUNCTION RichEditStreamInString (BYVAL dwCookie AS DWORD, BYVAL pbBuff AS BYTE PTR, _
                                         BYVAL cb AS LONG, pcb AS LONGAS DWORD
DECLARE SUB NewEvents
DECLARE SUB SyntaxColorBAS
DECLARE SUB SyntaxColorHTML
DECLARE SUB SyntaxColorRC
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Main entrance - create dialog and controls, etc
'------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
  LOCAL hDlg AS LONG
 
  DIALOG NEW 0, "PBtoRTF code viewer",,, 380, 240, %WS_OVERLAPPEDWINDOW, 0 TO hDlg
 
  CONTROL ADD BUTTON, hDlg, %IDC_OPEN, "&Open",   2, 2, 50, 14
  CONTROL ADD BUTTON, hDlg, %IDCANCEL, "E&xit",  56, 2, 50, 14
  CONTROL ADD LABEL, hDlg, %IDC_LABEL, "",      120, 0, 150, 18
 
  IF LoadLibrary("RICHED32.DLL") THEN
     CONTROL ADD "RichEdit", hDlg, %ID_RICHEDIT, "", 0, 18, 380, 190, _
                 %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR %WS_VSCROLL OR _
                 %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_MULTILINE OR _
                 %ES_NOHIDESEL OR %ES_SAVESEL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE  '%ES_READONLY ?
  ELSE
     EXIT FUNCTION
  END IF
 
  CONTROL SEND hDlg, %ID_RICHEDIT, %EM_SETOPTIONS, %ECOOP_OR, %ECO_SELECTIONBAR 'for left margin select..
  CONTROL SEND hDlg, %ID_RICHEDIT, %EM_EXLIMITTEXT,  0, 1024 * 1024 - 1 '1 MB limit?
 
  DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Main dialog's callback procedure
'------------------------------------------------------------------------------
CALLBACK FUNCTION DlgProc() AS LONG
 
  SELECT CASE CBMSG
     CASE %WM_INITDIALOG 'first message - initiate
        LOCAL dwStyle AS DWORD, fName AS STRING, sBuf AS STRING, rc AS RECT
        STATIC hEdit AS LONG, Path AS STRING
        hEdit = GetDlgItem(CBHNDL, %ID_RICHEDIT)
        Path = CURDIR$
 
     CASE %WM_COMMAND   'command message
        SELECT CASE CBCTL
           CASE %IDC_OPEN 'Open
              IF CBCTLMSG <> %BN_CLICKED THEN EXIT SELECT
              fName   = "*.BAS;*.INC"
              sBuf    = "PB code files (*.BAS, *.INC)|*.bas;*.inc|" + _
                        "HTML files (*.HTM, *.HTML)|*.htm;*.html|" + _
                        "Resource files (*.RC)|*.rc|" + _
                        "All Files (*.*)|*.*"
              dwStyle = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
              IF OpenFileDialog(CBHNDL, "", fName, Path, sBuf, "BAS", dwStyle) THEN
                 NewEvents                     'take a breath for proper redraw between actions
                 RichEditViewCode hEdit, fName 'start action
 
                 Path = LEFT$(fName, INSTR(-1, fName, ANY "\/"))
                 sBuf = "PBtoRTF Code viewer - " + fName
                 SetWindowText CBHNDL, BYVAL STRPTR(sBuf)
              END IF
 
           CASE %IDCANCEL 'Exit
              IF CBCTLMSG = %BN_CLICKED THEN DIALOG END CBHNDL
        END SELECT
 
     CASE %WM_SIZE 'resize message
        IF CBWPARAM <> %SIZE_MINIMIZED THEN
           GetWindowRect hEdit, rc           ' get Richedit's position on screen
           MapWindowPoints 0, CBHNDLvarptr(rc), 2  ' map rect to dialog - we need top pos
           SetWindowPos hEdit, 0, 0, 0, _
                        LOWRD(CBLPARAM), HIWRD(CBLPARAM) - rc.nTop, _
                        %SWP_NOMOVE OR %SWP_NOZORDER
        END IF
 
  END SELECT
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Custom DOEVENTS to make sure all pending messages are processed.
'------------------------------------------------------------------------------
SUB NewEvents
  LOCAL Msg AS tagMsg
  DO WHILE PeekMessage(Msg, 0, 0, 0, %PM_NOREMOVE) 'peek only, do not remove
     DIALOG DOEVENTS                               'let DDT handle all pending messages
  LOOP
END SUB
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Open given file, convert text to RTF and insert into Rich Edit
'------------------------------------------------------------------------------
FUNCTION RichEditViewCode (BYVAL hRichEdit AS LONG, BYVAL fName AS STRINGAS LONG
  LOCAL ff AS LONG, t AS SINGLE, txt AS STRING, eStream AS EDITSTREAM
 
  ff = FREEFILE
  OPEN fName FOR BINARY AS ff LEN = 8192
     IF ERR THEN                'if file couldn't be opened
        MessageBeep &HFFFFFFFF  'I prefer speaker beep on errors..
        RESET : ERRCLEAR        'Should of course flash a message here, but I'm too lazy today..
        EXIT FUNCTION
     END IF
     GET$ ff, LOF(ff), gTxt     'all is ok, read entire contents into global text buffer
  CLOSE ff                      'close file
 
  IF LEN(gTxt) = 0 THEN         'if length is zero, exit
     MessageBeep &HFFFFFFFF
     EXIT FUNCTION
  END IF
 
  CONTROL SET TEXT GetParent(hRichEdit), %IDC_LABEL, "Please wait.."
  MOUSEPTR 11             'show Hourglass mouse pointer during process
  t = TIMER               'for timing Syntax color parser
 
  IF UCASE$(RIGHT$(fName, 3)) = ".RCTHEN
     CALL SyntaxColorRC   'convert resource file code to RTF - this is fast
  ELSEIF UCASE$(RIGHT$(fName, 4)) = ".BASOR UCASE$(RIGHT$(fName, 4)) = ".INCTHEN
     CALL SyntaxColorBAS  'convert PB code to RTF - this is also fast
  ELSEIF UCASE$(RIGHT$(fName, 4)) = ".HTMOR UCASE$(RIGHT$(fName, 5)) = ".HTMLTHEN
     CALL SyntaxColorHTML 'convert PB code to RTF - this is also fast
  ELSE
     SendMessage hRichEdit, %WM_SETTEXT, 0, STRPTR(gTxt) 'else simply insert text and exit
     CONTROL SET TEXT GetParent(hRichEdit), %IDC_LABEL, "Not a code file!"
     EXIT FUNCTION
  END IF
 
  t   = TIMER - t
  txt = "Parsing took  " + FORMAT$(t, "0.000") + " sec."
  CONTROL SET TEXT GetParent(hRichEdit), %IDC_LABEL, txt + $CRLF + "Please wait.."
 
  t                   = TIMER         'for timing RichEdit
  gPos                = 1             'position in text to start from
  gPtr                = STRPTR(gTxt)  'pointer to global text buffer
  eStream.pfnCallback = CODEPTR(RichEditStreamInString) 'pointer to RichEdit callback procedure
  SendMessage hRichEdit, %EM_STREAMIN, %SF_RTF, VARPTR(eStream) 'stream in text
 
  t   = TIMER - t
  txt = txt + $CRLF + "RichEdit took  " + FORMAT$(t, "0.000") + " sec." + STR$(LEN(gTxt))
  CONTROL SET TEXT GetParent(hRichEdit), %IDC_LABEL, txt
 
  MOUSEPTR 1       'done, so time to reset mouse pointer
  gTxt = ""        'and we can clear global string buffer
 
  FUNCTION = %TRUE 'if we get to this point, it should be succes - return true
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Rich Edit stream in callback - for streaming in string contents
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
FUNCTION RichEditStreamInString (BYVAL dwCookie AS DWORD, BYVAL pbBuff AS BYTE PTR, _
                                 BYVAL cb AS LONG, pcb AS LONGAS DWORD
 
  pcb = MIN&(cbLEN(gTxt) - (gPos - 1)) 'number of bytes to copy
 
  IF pcb > 0 THEN        'copy block from global string directly into Richedit's buffer.
     CopyMemory pbBuff, (gPtr + gPos - 1), pcb  'could use POKE$ too, but this is a bit faster
     gPos = gPos + pcb   'incr pos for next callback position.
  ELSE
     FUNCTION = 1        'else break action
  END IF
 
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Redim and load given array with PB keyword data
'------------------------------------------------------------------------------
FUNCTION LoadPBdata(dArray() AS STRINGAS LONG
  LOCAL ii AS LONG, jj AS LONG, kk AS LONG, rc AS LONG
 
  rc = DATACOUNT
  REDIM dArray(rc - 1) AS STRING 'zero based, so -1
  REDIM aStart(26), aCount(26)   'for index
 
  FOR ii = 1 TO rc               'read the data into the array
     dArray(ii - 1) = UCASE$(READ$(ii))
  NEXT
 
  ARRAY SORT dArray()
 
  jj = 64  'Index on first character, $%&# = 0, A = 1, etc..
  FOR ii = 0 TO UBOUND(dArray)
     kk = ASC(dArray(ii))
     IF kk > jj THEN    'A - Z
        aCount(jj - 64) = MAX&(0, ii - 1) 'indexed end
        jj = kk
        aStart(kk - 64) = ii
     END IF
  NEXT
  aCount(jj - 64) = MAX&(0, ii - 1)
 
  FOR ii = 0 TO 26 're-calculate count
     IF aCount(ii) THEN aCount(ii) = MAX&(0, aCount(ii) - aStart(ii) + 1)
  NEXT
 
  FUNCTION = rc  'Return the count, in case we ever should need it..
 
'PB/WIN (DLL) keywords - think at least most of them..  :-)
DATA #BLOAT#COMPILE#DEBUG#DIM#ELSE#ELSEIF#ENDIF#IF#INCLUDE#OPTION#REGISTER#RESOURCE
DATA #SEGMENT, #STACK#TOOLS, $BEL, $BS, $COMPILE, $CR, $CRLF, $DEBUG, $DIM, $DQ, $ELSE, $ELSEIF, $ENDIF
DATA $EOF, $ESC, $FF, $IF, $INCLUDE, $LF, $NUL, $OPTION, $REGISTER, $RESOURCE, $SEGMENT, $SPC, $STACK
DATA $TAB, $VT, %DEF, %FALSE, %NULL, %PB_EXE, %TRUE
DATA ABSACCELACCEPT, ACCESS, ACODE$ADDADDR, ALIAS, ALL, AND, ANY, APPEND, ARRAYARRAYATTR
DATA ASASC, ASCEND, ASCIZ, ASCIIZ, AT, ATNATTACH, ATTRIB, BAR, BASE, BAUD, BDECL, BEEP
DATA BIN$, BINARY, BITBITS%BITS&BITS?BITS??BITS???, BREAK, BUTTON, BYCMD, BYCOPY, BYREF
DATA BYTE, BYVAL, CALCCALLCALLBACKCALLSTKCALLSTK$CALLSTKCOUNTCASECATCHCBCTLCBCTLMSG
DATA CBHNDLCBLPARAMCBMSGCBWPARAMCBYTCCURCCUX, CD, CDBL, CDECL, CDWDCEILCEXTCHDIR
DATA CHDRIVECHECKCHECK3STATECHECKBOXCHOOSE, CHOOSE&, CHOOSE%, CHOOSE$, CHR$CINTCLIENTCLNG
DATA CLOSE, CLS, CLSID$CODEPTRCOLLATECOLORCOMBOBOXCOMMCOMMAND$, CON, CONNECT, CONST, CONTROL
DATA COSCQUDCREATECSETCSET$CSNG, CTSFLOW, CUR, CURDIR$, CURRENCY, CURRENCYX, CUX, CVBYTCVCUR
DATA CVCUXCVDCVDWDCVECVICVLCVQCVSCVWRDCWRDDATADATACOUNTDATE$DECLAREDECRDEFAULT
DATA DEFBYTDEFCURDEFCUXDEFDBLDEFDWDDEFEXTDEFINTDEFLNGDEFQUDDEFSNGDEFSTRDEFWRDDELETE
DATA DESCEND, DIALOGDIMDIR$DISABLEDISKFREEDISKSIZE, DISPATCH, DLL, DLLMAINDODOEVENTS, DOUBLE
DATA DOWN, DRAW, DSRFLOW, DSRSENS, DTRFLOW, DTRLINE, DWORDELSEELSEIF, EMPTY, ENABLEENDENVIRON$
DATA EOFEQVERASEERR, ERRAPI, ERRCLEARERRORERROR$EXEEXITEXPEXP10EXP2EXPLICIT, EXPORT
DATA EXT, EXTENDED, EXTRACT$FILEATTRFILECOPYFILENAME$FILESCAN, FILL, FINALLYFIX, FLOW, FLUSHFOCUS
DATA FONTFORFORMAT$FORMFEEDFRACFRAMEFREEFILEFROMFUNCTIONFUNCNAME$GET, GET#, GET$
DATA GETATTRGLOBALGOSUBGOTOGUID$GUIDTXT$HANDLEHEX$HIBYTHIINTHIWRDHOST, ICASE, ICON
DATA IDN, IF, IFACE, IIFIIF&, IIF%, IIF$IMAGEIMAGEXIMGBUTTONIMGBUTTONXIMP, IN, INCR, INP, INOUT
DATA INPUTINPUT#INPUTBOX$INSERTINSTRINTINTERFACE, INTEGER, INV, ISFALSEISNOTHING
DATA ISOBJECTISTRUEITERATEJOIN$KILLLABELLBOUNDLCASE$, LEFT, LEFT$LENLET, LIB, LIBMAIN
DATA LINELISTBOXLOBYTLOCLOCALLOCKLOFLOGLOG10LOG2LOINTLONGLOOPLOWRDLPRINT
DATA LSETLSET$LTRIM$MACROMACROTEMP, MAIN, MAKDWDMAKINTMAKLNGMAKPTRMAKWRDMATMAXMAX$
DATA MAX%, MAX&, MCASE$MEMBERMENUMID$MINMIN$, MIN%, MIN&, MKBYT$MKCUR$MKCUX$MKD$
DATA MKDIRMKDWD$MKE$MKI$MKL$MKQ$MKS$MKWRD$MODMODALMODELESSMOUSEPTRMSGBOX
DATA NAMENEWNEXT, NONE, NOT, NOTHING, NOTIFY, NULL, OBJACTIVEOBJECTOBJPTROBJRESULTOCT$, OF
DATA OFFONOPEN, OPT, OPTION, OPTIONAL, OR, OUT, OUTPUT, PAGE, PARITY, PARITYCHAR, PARITYREPL, PARITYTYPE
DATA PARSEPARSE$PARSECOUNT, PBD, PBMAINPEEKPEEK$PIXELS, POINTER, POKEPOKE$POPUPPORTPOST
DATA PRESERVEPRINTPRINT#, PRIVATE, PROFILEPROGID$, PTR, PUTPUT$, QUAD, QWORD, RANDOM, RANDOMIZE, READ
DATA READ$, RECEIVE, RECORDS, RECVREDIMREDRAWREGEXPRREGISTERREGREPLREMAIN$REMOVE$REPEAT$
DATA REPLACERESETRESUME, RET16, RET32, RET87, RETAIN$, RETP16, RETP32, RETPRM, RETURNRGB, RIGHT
DATA RIGHT$, RING, RLSD, RMDIRRNDROTATEROUNDRSETRSET$RTRIM$, RTSFLOW, RXBUFFER, RXQUE, SCAN
DATA SCROLLBAR, SDECL, SEEKSELECTSENDSERVERSETSETATTRSETEOFSGN, SHARED, SHELL
DATA SHIFTSHOW, SIGNED, SINSINGLESIZESIZEOFSLEEPSORTSPACE$, SPC, SQRSTATESTATICSTATUS
DATA STDCALL, STEP, STOP, STR$STRDELETE$STRINGSTRING$STRINSERT$STRPTRSTRREVERSE$SUBSUSPEND
DATA SWAPSWITCH, SWITCH&, SWITCH%, SWITCH$TABTAB$, TAGARRAY, TALLYTANTCPTEXTTEXTBOXTHEN
DATA THREADTHREADCOUNTTHREADIDTIME$, TIMEOUT, TIMERTOTOGGLETRACETRIM$, TRN, TRY, TXBUFFER
DATA TXQUE, TYPEUBOUND, UCASE, UCASE$UCODE$UDPUNIONUNITSUNLOCKUNTIL, UP, USER, USING, USING$
DATA VAL, VARIANT, VARIANT#VARIANT$VARIANTVTVARPTRVERIFY, VERSION3, VERSION4, VERSION5
DATA WENDWHILEWIDTH, WIDTH#, WINMAIN, WITH, WORD, WRITEWRITE#XOR, XINPFLOW, XOUTFLOW, ZER
 
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Load HTML keywords into memory block
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
FUNCTION LoadHTMLdata(dArray() AS STRINGAS LONG
  LOCAL ii AS LONG, jj AS LONG, kk AS LONG, rc AS LONG
 
  rc = DATACOUNT
  REDIM dArray(rc - 1) AS STRING 'zero based, so -1
  REDIM aStart(26), aCount(26)   'for index
 
  FOR ii = 1 TO rc               'read the data into the array
     dArray(ii - 1) = UCASE$(READ$(ii))
  NEXT
 
  ARRAY SORT dArray()
 
  jj = 64  'Index on first character, $%&# = 0, A = 1, etc..
  FOR ii = 0 TO UBOUND(dArray)
     kk = ASC(dArray(ii))
     IF kk > jj THEN    'A - Z
        aCount(jj - 64) = MAX&(0, ii - 1) 'indexed end
        jj = kk
        aStart(kk - 64) = ii
     END IF
  NEXT
  aCount(jj - 64) = MAX&(0, ii - 1)
 
  FOR ii = 0 TO 26 're-calculate count
     IF aCount(ii) THEN aCount(ii) = MAX&(0, aCount(ii) - aStart(ii) + 1)
  NEXT
 
  FUNCTION = rc  'Return the count, in case we ever should need it..
 
'HTML syntax color data
DATA A, ABBR, ACCESSKEY, ACRONYM, ACTION, ADDRESS, ALIGN, ALINK, ALT, APPLET, ARCHIVE, AREA, AU, AXIS
DATA B, BACKGROUND, BANNER, BASE, BASEFONT, BGCOLOR, BGSOUND, BIG, BLINK, BLOCKQUOTE
DATA BODY, BORDER, BORDERCOLORLIGHT, BOTTOM, BQ, BR, BUTTON
DATA CAPTION, CDATA, CELLPADDING, CELLSPACING, CENTER, CHAR, CHAROFF, CHARSET, CHECKED, CITE, CLASS, CLASSID
DATA CLEARCODE, CODEBASE, CODETYPE, COL, COLGROUP, COLOR, COLS, COLSPAN, COMMENT, CONTENT, COORDS
DATA DAT, DATA, DATETIME, DECLARE, DD, DEFER, DFN, DEL, DIR, DISABLED, DISABLES, DIV, DL, DOCTYPE, DT
DATA EM, EMBED, FACE, FIG, FIELDSET, FN, FONT, FORM, FRAME, FRAMEBORDER, FRAMESET
DATA H1, H2, H3, H4, H5, H6, HEAD, HEADERS, HEIGHT, HIGH, HR, HREF, HREFLANG, HSPACE, HTML, HTTP-EQUIV
DATA I, ID, IFRAME, IMG, INPUT, INS, ISMAP, JUSTIFY, KBD
DATA LABEL, LANG, LANGUAGE, LEGEND, LEFT, LEFTMARGIN, LI, LINK, LISTING, LONGDESC, LOOP, LOW
DATA MAP, MARGINHEIGHT, MARGINLEFT, MARGINRIGHT, MARGINWIDTH, MARQUEE, MAXLENGTH, MEDIA, MENU, META
DATA METHOD, MIDDLE, MULTICOL
DATA NAME, NEXTID, NOBR, NOFRAMES, NORESIZE, NOSAVE, NOSCRIPT, NOSHADE, NOTE, NOWRAP
DATA OBJECT, OL, ONBLUR, ONCHANGE, ONFOCUS, ONLOAD, ONMOUSEOUT, ONMOUSEOVER, ONMOUSEUP, ONSELECT
DATA ONUNLOAD, OPTGROUP, OPTIONOVERLAY
DATA P, PARAM, PERSON, PLAINTEXT, PLUGINSPAGE, PRE, PROFILE, PUBLIC
DATA Q, QUALITYRANGE, READONLY, RECT, REF, REL, RESET, REV, RIGHT, RIGHTMARGIN, ROW, ROWS, ROWSPAN
DATA S, SAMP, SCHEME, SCOPE, SCRIPT, SCRIPTA, SCROLLING, SELECT, SELECTED, SHAPE, SIZE, SMALL, SOUND
DATA SPACER, SPAN, SRC, STANDBY, STRIKE, STRONG, STYLESUB, SUBMIT, SUMMARY, SUP
DATA TAB, TABINDEX, TABLE, TARGET, TBODY, TD, TEXT, TEXTAREA, TFOOT, TH, THEAD, TITLE, TOP, TOPMARGIN
DATA TR, TT, TYPE, U, UL, URL, USEMAP, VALIGN, VALUE, VALUETYPE, VAR, VLINK, VSPACE, WBR, WIDTH, WRAP, XMP
 
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Redim and load given array with Resource file keywords
'------------------------------------------------------------------------------
FUNCTION LoadRCdata(dArray() AS STRINGAS LONG
  LOCAL ii AS LONG, jj AS LONG, kk AS LONG, rc AS LONG
 
  rc = DATACOUNT
  REDIM dArray(rc - 1) AS STRING 'zero based, so -1
  REDIM aStart(26), aCount(26)   'for index
 
  FOR ii = 1 TO rc               'read the data into the array
     dArray(ii - 1) = UCASE$(READ$(ii))
  NEXT
 
  ARRAY SORT dArray()
 
  jj = 64  'Index on first character, $%&# = 0, A = 1, etc..
  FOR ii = 0 TO UBOUND(dArray)
     kk = ASC(dArray(ii))
     IF kk > jj THEN    'A - Z
        aCount(jj - 64) = MAX&(0, ii - 1) 'indexed end
        jj = kk
        aStart(kk - 64) = ii
     END IF
  NEXT
  aCount(jj - 64) = MAX&(0, ii - 1)
 
  FOR ii = 0 TO 26 're-calculate count
     IF aCount(ii) THEN aCount(ii) = MAX&(0, aCount(ii) - aStart(ii) + 1)
  NEXT
 
  FUNCTION = rc  'Return the count, in case we ever should need it..
 
'RC syntax color data, extracted from RCDLL.DLL, the RC help file and other sources..  :-)
'Note, first line, definition words, must be lower case in RC file. Is upper case
'here for search resons, but will *not* be automatically changed in text, since RC.EXE
'is case sensitive.
 
DATA #INCLUDE, #DEFINE, #ELIF, #ELSE#ENDIF#IF, #IFDEF, #IFNDEF, #INCLUDE, #PRAGMA, #UNDEF
DATA ACCELERATOR, ACCELERATORS, ALT, ANICURSOR, ANIICON, ASCII, AUTO3STATE
DATA AUTOCHECKBOX, AUTORADIOBUTTON, AVI, BEDIT, BEGIN, BITMAPBLOCKBUTTON
DATA CAPTION, CHARACTERISTICS, CHECKBOX, CHECKED, CLASSCOMBOBOXCONTROL, CTEXT, CURSOR
DATA DEFPUSHBUTTON, DIALOG, DIALOGEX, DISCARDABLE, DLGINCLUDE, DLGINIT, EDIT, EDITTEXT, END, EXSTYLE
DATA FILEFLAGS, FILEFLAGSMASK, FILEOS, FILESUBTYPE, FILETYPE, FILEVERSION, FIXED, FONT, FONTDIR
DATA GRAYED, GROUP_CURSOR, GROUP_ICON, GROUPBOX, HELPICON, IEDIT, IMPURE, INACTIVE
DATA LANGUAGE, LISTBOX, LOADONCALL, LTEXT, MAINMENU, MENU, MENUBARBREAK, MENUBREAK, MENUEX
DATA MENUITEM, MESSAGETABLE, MOVEABLE, NOINVERT, NONSHARED, NOT, OBJECTS, OWNERDRAW
DATA PLUGPLAY, POPUP, PRELOAD, PRODUCTVERSION, PURE, PUSHBOX, PUSHBUTTON, RADIOBUTTON, RCDATA, RTEXT
DATA SCROLLBARSEPARATOR, SHARED, SHIFT, STATE3, STATICSTRING, STRINGTABLE, STYLE, SOUND
DATA USERBUTTON, VALUE, VERSION, VERSIONINFO, VIRTKEY, VS_VERSION_INFO, WAVE, VXD
 
END FUNCTION
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Parser builds syntax colored RTF from PB code files. Here we use pointers and
' pre-allocated output string for good speed. Should be fast enough for most needs.
'------------------------------------------------------------------------------
SUB SyntaxColorBAS
  LOCAL ii AS LONG, Ac AS LONG, stopPos AS LONG, Result AS LONG
  LOCAL wFlag AS LONG, remFlag AS LONG, dqFlag AS LONG
  LOCAL pLet AS BYTE PTR, pLet2 AS BYTE PTR
  LOCAL tmpWord AS STRING, outBuf AS STRING, uCaseBuf AS STRING
  LOCAL rtfPrefix AS STRING, rtfPostfix AS STRING, endBlock AS STRING, endBlue AS STRING
  LOCAL greenStr AS STRING, blueStr AS STRING, redStr AS STRING, PBFstr AS STRING
 
  DIM cData() AS STRING
  LoadPBdata cData()    'load PB keywords into array
 
  rtfPrefix =  "{\rtf1\ansi \deff0{\fonttbl{\f0\fmodern Courier New;}}" + _  'RTF header
               "{\colortbl;\red0\green128\blue0;" + _  'cf1, green
               "\red255\green255\blue255;" + _         'cf2, white
               "\red0\green0\blue255;" + _             'cf3, blue
               "\red0\green0\blue0;" + _               'cf4, black
               "\red255\green0\blue0;" + _             'cf5, red
               "\red192\green100\blue0;}" + _          'cf6, brown (#PBForms)
               "\deftab1134\margl0\margt0\margr0\margb0\plain\f0\fs18 "
  rtfPostfix = "\n\par }"         'RTF end
  endBlock   = "\plain\f0\fs18 "  'block end
  endBlue    = "\plain\f0\fs18b"  'use temporary block end for blue color, to enable size trim
  greenStr   = "\cf1 "            'green block start (uncommented)
  blueStr    = "\cf3 "            'blue block start  (PB keywords)
  redStr     = "\cf5 "            'red block start   (string literals and asm)
  PBFstr     = "\cf6 "            'PBForms block start
 
  gTxt = gTxt + " "                'add a space to ensure last word will be checked if nothing follows it
  REPLACE "\" WITH "\\" IN gTxt    'RTF needs this to understand backslash
  REPLACE "{" WITH "\{" IN gTxt    'RTF needs this to understand {
  REPLACE "}" WITH "\}" IN gTxt    'RTF needs this to understand }
  OutBuf   = STRING$(MAX&(1000, 3 * LEN(gTxt)), 0) 'create enough big output buffer
  uCaseBuf = UCASE$(gTxt)          'use uppercase string for compare
  pLet     = STRPTR(gTxt)          'pointer to global string (input)
  pLet2    = STRPTR(OutBuf)        'pointer to output buffer
 
  FOR ii = 1 TO LEN(gTxt)
     SELECT CASE @pLet            'the characters we need to inlude in a word
        CASE 65 TO 90, 97 TO 122, 35 TO 38, 48 TO 57, 63, 95
           IF wFlag = 0 AND remFlag = 0 AND dqFlag = 0 THEN
              wFlag = 1 : stopPos = ii
           END IF
 
        CASE 34 ' double quote -> "
           IF dqFlag = 0 AND remFlag = 0 THEN  'if start of string literal
              POKE$ pLet2, redStr              'poke RTF code into output string
              pLet2 = pLet2 + 5                'and move pointer forward
              dqFlag = 1 : wFlag = 0           'set flags - since now inside DQ, wordflag is off
           ELSEIF dqFlag = 1 THEN              'should be end of DQ block
              @pLet2 = @pLet                   'set value in output string
              INCR pLet2                       'move one character ahead
              POKE$ pLet2, endBlock            'poke RTF end block string into output
              pLet2 = pLet2 + 15               'and move pointer forward
              dqFlag = 3                       'end of DQ - set DQ flag
           END IF
 
        CASE 59 ' asm uncomment character -> ;
           IF remFlag = 0 AND dqFlag = 2 THEN
              POKE$ pLet2, endBlock
              pLet2 = pLet2 + 15
              POKE$ pLet2, greenStr
              pLet2 = pLet2 + 5
              remFlag = 1 : wFlag = 0
           END IF
 
        CASE 39 ' uncomment character -> '
           IF remFlag = 0 AND dqFlag <> 1 THEN
              IF dqFlag = 2 THEN
                 POKE$ pLet2, endBlock
                 pLet2 = pLet2 + 15
              END IF
              POKE$ pLet2, greenStr
              pLet2 = pLet2 + 5
              remFlag = 1 : wFlag = 0
           END IF
 
        CASE 33 ' asm character -> !
           IF remFlag = 0 AND dqFlag = 0 THEN
              POKE$ pLet2, redStr
              pLet2 = pLet2 + 5
              dqFlag = 2 : wFlag = 0
           END IF
 
        CASE ELSE  'word is ready
           IF @pLet = 13 THEN    'if CRLF - end of line
              IF remFlag OR dqFlag THEN   'if in rem, asm or unfinished string literal (DQ)
                 POKE$ pLet2, endBlock
                 pLet2 = pLet2 + 15
                 remFlag = 0 : wFlag = 0 : dqFlag = 0  'reset all flags
              END IF
           END IF
 
           IF wFlag = 1 THEN 'if we have a word
              tmpWord = MID$(uCaseBuf, stopPos, ii - stopPos)  'Get word
 
              Ac = ASC(tmpWord)         'look at first letter
              IF Ac < 91 THEN           'if within English alphabet
                 Ac = MAX&(0, Ac - 64)  'convert for index array
                 ARRAY SCAN cData(aStart(Ac)) FOR aCount(Ac), = tmpWord, TO Result 'is it in the array?
              END IF
 
              IF Result THEN                  'if match was found, it's a PB keyword
                 pLet2 = pLet2 - LEN(tmpWord) 'set position to start of word
                 POKE$ pLet2, blueStr         'and poke RTF string for blue color into output string
                 pLet2 = pLet2 + 5            'move pointer ahead
                 POKE$ pLet2, tmpWord         'poke the word into output string
                 pLet2 = pLet2 + LEN(tmpWord) 'move pointer ahead
                 POKE$ pLet2, endBlue       'and finally poke RTF end block string into output-
                 pLet2 = pLet2 + 15           'move pointer ahead
                 Result = 0                   'and reset result
              ELSE
                 IF tmpWord = "REMTHEN  'extra for REM keyword
                    pLet2 = pLet2 - 3     'set position to start of word
                    POKE$ pLet2, greenStr
                    pLet2 = pLet2 + 5
                    POKE$ pLet2, tmpWord
                    pLet2 = pLet2 + 3
                    remFlag = 1
 
                 ELSEIF tmpWord = "#PBFORMSTHEN  'extra for #PBFORMS statement
                    pLet2 = pLet2 - 8              'set position to start of word
                    POKE$ pLet2, PBFstr
                    pLet2 = pLet2 + 5
                    POKE$ pLet2, tmpWord
                    pLet2 = pLet2 + 8
                    remFlag = 1
 
                 ELSEIF tmpWord = "ASMTHEN  'extra for ASM keyword
                    pLet2 = pLet2 - 3         'set position to start of word
                    POKE$ pLet2, RedStr
                    pLet2 = pLet2 + 5
                    POKE$ pLet2, tmpWord
                    pLet2 = pLet2 + 3
                    dqFlag = 2
                 END IF
 
              END IF
              wFlag = 0
           END IF
     END SELECT
 
     IF dqFlag <> 3 THEN       'if not handled matching double-quote
        @pLet2 = @pLet         'copy original character to output
        INCR pLet2             'and increase pos in output
     ELSE
        dqFlag = 0             'else reset DQ flag
     END IF
     INCR pLet                 'move ahead to next character
  NEXT ii
 
  gTxt = EXTRACT$(OutBuf, CHR$(32, 0))      'extract result (and remove the added space)
 
  REPLACE endBlue + " " + blueStr WITH " " IN gTxt    'Trim size: If keywords follows each other,
  REPLACE endBlue WITH endBlock IN gTxt               'replace remaining blue endblocks with proper RTF
 
  REPLACE $CRLF WITH "\par " IN gTxt    'RTF likes this kind of line feed better
  gTxt = rtfPrefix + gTxt + rtfPostfix  'combine RTF header + result + end string
 
END SUB
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Parser builds syntax colored RTF from HTML files.
'------------------------------------------------------------------------------
SUB SyntaxColorHTML
  LOCAL ii AS LONG, Ac AS LONG, stopPos AS LONG, Result AS LONG
  LOCAL wFlag AS LONG, dqFlag AS LONG, IsHtml AS LONG
  LOCAL pLet AS BYTE PTR, pLet2 AS BYTE PTR
  LOCAL tmpWord AS STRING, outBuf AS STRING, uCaseBuf AS STRING
  LOCAL rtfPrefix AS STRING, rtfPostfix AS STRING, endBlock AS STRING, endBlue AS STRING
  LOCAL greenStr AS STRING, blueStr AS STRING, redStr AS STRING, PBFstr AS STRING
 
  DIM cData() AS STRING
  LoadHTMLdata cData()    'load RC keywords into array
 
  rtfPrefix =  "{\rtf1\ansi \deff0{\fonttbl{\f0\fmodern Courier New;}}" + _  'RTF header
               "{\colortbl;\red0\green128\blue0;" + _  'cf1, green
               "\red255\green255\blue255;" + _         'cf2, white
               "\red0\green0\blue255;" + _             'cf3, blue
               "\red0\green0\blue0;" + _               'cf4, black
               "\red255\green0\blue0;" + _             'cf5, red
               "\red192\green100\blue0;}" + _          'cf6, brown (#PBForms)
               "\deftab1134\margl0\margt0\margr0\margb0\plain\f0\fs18 "
 
  rtfPostfix = "\n\par }"         'RTF end
  endBlock   = "\plain\f0\fs18 "  'block end
  endBlue    = "\plain\f0\fs18b"  'use temporary block end for blue color, to enable size trim
  greenStr   = "\cf1 "            'green block start
  blueStr    = "\cf3 "            'blue block start
  redStr     = "\cf5 "            'red block start
  PBFstr     = "\cf6 "            'PBForms block start
 
  REPLACE "<" WITH "<" IN gTxt
  gTxt = gTxt + " "                'add a space to ensure last word will be checked if nothing follows it
  REPLACE "\" WITH "\\" IN gTxt    'RTF needs this to understand backslash
  REPLACE "{" WITH "\{" IN gTxt    'RTF needs this to understand {
  REPLACE "}" WITH "\}" IN gTxt    'RTF needs this to understand }
  OutBuf   = STRING$(MAX&(1000, 3 * LEN(gTxt)), 0) 'create enough big output buffer
  uCaseBuf = UCASE$(gTxt)          'use uppercase string for compare
  pLet     = STRPTR(gTxt)          'pointer to global string (input)
  pLet2    = STRPTR(OutBuf)        'pointer to output buffer
 
  FOR ii = 1 TO LEN(gTxt)
     SELECT CASE @pLet            'the characters we need to inlude in a word
        CASE 60 : IsHtml = 1 '<
 
        CASE 65 TO 90, 97 TO 122, 35 TO 38, 48 TO 57, 63, 95, 45
           IF IsHtml AND wFlag = 0 AND dqFlag = 0 THEN
              wFlag = 1 : stopPos = ii
           END IF
 
        CASE 34 ' double quote -> "
           IF dqFlag = 0 THEN                  'if start of string literal
              POKE$ pLet2, redStr              'poke RTF code into output string
              pLet2 = pLet2 + 5                'and move pointer forward
              dqFlag = 1 : wFlag = 0           'set flags - since now inside DQ, wordflag is off
           ELSEIF dqFlag = 1 THEN              'should be end of DQ block
              @pLet2 = @pLet                   'set value in output string
              INCR pLet2                       'move one character ahead
              POKE$ pLet2, endBlock            'poke RTF end block string into output
              pLet2 = pLet2 + 15               'and move pointer forward
              dqFlag = 3                       'end of DQ - set DQ flag
           END IF
 
        CASE ELSE  'word is ready
           IF @pLet = 13 THEN    'if CRLF - end of line
              IF dqFlag THEN     'if unfinished string literal (DQ)
                 POKE$ pLet2, endBlock
                 pLet2 = pLet2 + 15
                 wFlag = 0 : dqFlag = 0  'reset all flags
              END IF
           END IF
 
           IF wFlag = 1 THEN 'if we have a word
              tmpWord = MID$(uCaseBuf, stopPos, ii - stopPos)  'Get word
 
              Ac = ASC(tmpWord)         'look at first letter
              IF Ac < 91 THEN           'if within English alphabet
                 Ac = MAX&(0, Ac - 64)  'convert for index array
                 ARRAY SCAN cData(aStart(Ac)) FOR aCount(Ac), = tmpWord, TO Result 'is it in the array?
              END IF
 
              IF Result THEN                  'if match was found, it's an RC keyword
                 'tmpWord = MID$(gTxt, stopPos, ii - stopPos) 'use original word - RC compiler is case sensitive..
                 pLet2 = pLet2 - LEN(tmpWord) 'set position to start of word
                 POKE$ pLet2, blueStr         'and poke RTF string for blue color into output string
                 pLet2 = pLet2 + 5            'move pointer ahead
                 POKE$ pLet2, tmpWord         'poke the word into output string
                 pLet2 = pLet2 + LEN(tmpWord) 'move pointer ahead
                 POKE$ pLet2, endBlue         'and finally poke end block for blue into output
                 pLet2 = pLet2 + 15           'move pointer ahead
                 Result = 0                   'and reset result
              END IF
              wFlag = 0
           END IF
           IF @pLet = 62 THEN IsHtml = 0
     END SELECT
 
     IF dqFlag <> 3 THEN       'if not handled matching double-quote
        @pLet2 = @pLet         'copy original character to output
        INCR pLet2             'and increase pos in output
     ELSE
        dqFlag = 0             'else reset DQ flag
     END IF
     INCR pLet                 'move ahead to next character
  NEXT ii
 
  gTxt = EXTRACT$(OutBuf, CHR$(32, 0))      'extract result (and remove the added space)
 
  REPLACE endBlue + " " + blueStr WITH " " IN gTxt    'If two PB keywords follows each other,
  REPLACE endBlue WITH endBlock IN gTxt               'replace remaining blue endblocks with proper RTF
 
  REPLACE $CRLF WITH "\par " IN gTxt    'RTF likes this kind of line feed better
  gTxt = rtfPrefix + gTxt + rtfPostfix  'combine RTF header + result + end string
 
END SUB
 
'いいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいいい
' Parser builds syntax colored RTF from resource files (RC).
'------------------------------------------------------------------------------
SUB SyntaxColorRC
  LOCAL ii AS LONG, Ac AS LONG, stopPos AS LONG, Result AS LONG
  LOCAL wFlag AS LONG, remFlag AS LONG, dqFlag AS LONG
  LOCAL pLet AS BYTE PTR, pLet2 AS BYTE PTR
  LOCAL tmpWord AS STRING, outBuf AS STRING, uCaseBuf AS STRING
  LOCAL rtfPrefix AS STRING, rtfPostfix AS STRING, endBlock AS STRING, endBlue AS STRING
  LOCAL greenStr AS STRING, blueStr AS STRING, redStr AS STRING, PBFstr AS STRING
 
  DIM cData() AS STRING
  LoadRCdata cData()    'load RC keywords into array
 
  rtfPrefix =  "{\rtf1\ansi \deff0{\fonttbl{\f0\fmodern Courier New;}}" + _  'RTF header
               "{\colortbl;\red0\green128\blue0;" + _  'cf1, green
               "\red255\green255\blue255;" + _         'cf2, white
               "\red0\green0\blue255;" + _             'cf3, blue
               "\red0\green0\blue0;" + _               'cf4, black
               "\red255\green0\blue0;" + _             'cf5, red
               "\red192\green100\blue0;}" + _          'cf6, brown (#PBForms)
               "\deftab1134\margl0\margt0\margr0\margb0\plain\f0\fs18 "
 
  rtfPostfix = "\n\par }"         'RTF end
  endBlock   = "\plain\f0\fs18 "  'block end
  endBlue    = "\plain\f0\fs18b"  'use temporary block end for blue color, to enable size trim
  greenStr   = "\cf1 "            'green block start
  blueStr    = "\cf3 "            'blue block start
  redStr     = "\cf5 "            'red block start
  PBFstr     = "\cf6 "            'PBForms block start
 
  gTxt = gTxt + " "                'add a space to ensure last word will be checked if nothing follows it
  REPLACE "\" WITH "\\" IN gTxt    'RTF needs this to understand backslash
  REPLACE "{" WITH "\{" IN gTxt    'RTF needs this to understand {
  REPLACE "}" WITH "\}" IN gTxt    'RTF needs this to understand }
  OutBuf   = STRING$(MAX&(1000, 3 * LEN(gTxt)), 0) 'create enough big output buffer
  uCaseBuf = UCASE$(gTxt)          'use uppercase string for compare
  pLet     = STRPTR(gTxt)          'pointer to global string (input)
  pLet2    = STRPTR(OutBuf)        'pointer to output buffer
 
  FOR ii = 1 TO LEN(gTxt)
     SELECT CASE @pLet            'the characters we need to inlude in a word
        CASE 65 TO 90, 97 TO 122, 35 TO 38, 48 TO 57, 63, 95
           IF wFlag = 0 AND remFlag = 0 AND dqFlag = 0 THEN
              wFlag = 1 : stopPos = ii
           END IF
 
        CASE 34 ' double quote -> "
           IF dqFlag = 0 AND remFlag = 0 THEN  'if start of string literal
              POKE$ pLet2, redStr              'poke RTF code into output string
              pLet2 = pLet2 + 5                'and move pointer forward
              dqFlag = 1 : wFlag = 0           'set flags - since now inside DQ, wordflag is off
           ELSEIF dqFlag = 1 THEN              'should be end of DQ block
              @pLet2 = @pLet                   'set value in output string
              INCR pLet2                       'move one character ahead
              POKE$ pLet2, endBlock            'poke RTF end block string into output
              pLet2 = pLet2 + 15               'and move pointer forward
              dqFlag = 3                       'end of DQ - set DQ flag
           END IF
 
        CASE 47 ' uncomment character -> /
           IF remFlag = 0 AND dqFlag <> 1 THEN
              IF ii < LEN(gTxt) AND PEEK(pLet + 1) = 47 THEN 'if //
                 POKE$ pLet2, greenStr
                 pLet2 = pLet2 + 5
                 remFlag = 1 : wFlag = 0
              END IF
           END IF
 
        CASE ELSE  'word is ready
           IF @pLet = 13 THEN    'if CRLF - end of line
              IF remFlag OR dqFlag THEN   'if in rem or unfinished string literal (DQ)
                 POKE$ pLet2, endBlock
                 pLet2 = pLet2 + 15
                 remFlag = 0 : wFlag = 0 : dqFlag = 0  'reset all flags
              END IF
           END IF
 
           IF wFlag = 1 THEN 'if we have a word
              tmpWord = MID$(uCaseBuf, stopPos, ii - stopPos)  'Get word
 
              Ac = ASC(tmpWord)         'look at first letter
              IF Ac < 91 THEN           'if within English alphabet
                 Ac = MAX&(0, Ac - 64)  'convert for index array
                 ARRAY SCAN cData(aStart(Ac)) FOR aCount(Ac), = tmpWord, TO Result 'is it in the array?
              END IF
 
              IF Result THEN                  'if match was found, it's an RC keyword
                 tmpWord = MID$(gTxt, stopPos, ii - stopPos) 'use original word - RC compiler is case sensitive..
                 pLet2 = pLet2 - LEN(tmpWord) 'set position to start of word
                 POKE$ pLet2, blueStr         'and poke RTF string for blue color into output string
                 pLet2 = pLet2 + 5            'move pointer ahead
                 POKE$ pLet2, tmpWord         'poke the word into output string
                 pLet2 = pLet2 + LEN(tmpWord) 'move pointer ahead
                 POKE$ pLet2, endBlue         'and finally poke end block for blue into output
                 pLet2 = pLet2 + 15           'move pointer ahead
                 Result = 0                   'and reset result
              END IF
              wFlag = 0
           END IF
     END SELECT
 
     IF dqFlag <> 3 THEN       'if not handled matching double-quote
        @pLet2 = @pLet         'copy original character to output
        INCR pLet2             'and increase pos in output
     ELSE
        dqFlag = 0             'else reset DQ flag
     END IF
     INCR pLet                 'move ahead to next character
  NEXT ii
 
  gTxt = EXTRACT$(OutBuf, CHR$(32, 0))      'extract result (and remove the added space)
 
  REPLACE endBlue + " " + blueStr WITH " " IN gTxt    'If two PB keywords follows each other,
  REPLACE endBlue WITH endBlock IN gTxt               'replace remaining blue endblocks with proper RTF
 
  REPLACE $CRLF WITH "\par " IN gTxt    'RTF likes this kind of line feed better
  gTxt = rtfPrefix + gTxt + rtfPostfix  'combine RTF header + result + end string
 
END SUB
 
'gbs_01062
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm