home *** CD-ROM | disk | FTP | other *** search
/ ftp.alaska-software.com / 2014.06.ftp.alaska-software.com.tar / ftp.alaska-software.com / acsn / RTF100.ZIP / alaskrtf.prg < prev    next >
Text File  |  1999-12-15  |  39KB  |  1,388 lines
  1. * -----------------------------
  2. * PROGRAM  : ALASRTF.PRG
  3. * VERSION  : 1.00
  4. * DATE     : 15 december 1999
  5. * LANGUAGE : XBASE++
  6. * AUTHOR   : PAUL C. Laney
  7. * -----------------------------
  8.  
  9. /*----------------------------------------------------------------------------//
  10. !short: Default parameters management */
  11.  
  12. #xcommand DEFAULT <uVar1> := <uVal1> ;
  13.                [, <uVarN> := <uValN> ] => ;
  14.                   <uVar1> := If( <uVar1> == nil, <uVal1>, <uVar1> ) ;;
  15.                 [ <uVarN> := If( <uVarN> == nil, <uValN>, <uVarN> ); ]
  16.  
  17. #include "richtext.ch"
  18.  
  19. CLASS RichText
  20.  
  21.    EXPORTED:
  22.    VAR cFileName, hFile, nFontSize, nScale, lTrimSpaces, nFontNum
  23.    VAR aTranslate, cTblHAlign, cCode
  24.  
  25.    VAR nTblFntNum, nTblFntSize, nTblRows, nTblColumns
  26.    VAR nTblRHgt, aTableCWid, cRowBorder, cCellBorder, nCellPct
  27.    VAR lTblNoSplit, nTblHdRows, nTblHdHgt, nTblHdPct, nTblHdFont
  28.    VAR nTblHdFSize
  29.    VAR cCellAppear, cHeadAppear
  30.    VAR cCellHAlign, cHeadHAlign
  31.    VAR nCurrRow, nCurrColumn
  32.  
  33.  
  34.    METHOD Appearance
  35.    METHOD BorderCode
  36.    METHOD Borders
  37.  
  38.    INLINE METHOD CloseGroup()
  39.       Fwrite( ::hFile, "}" )
  40.    RETURN (Self)
  41.  
  42.    METHOD DefineTable
  43.    METHOD FormatCode
  44.    METHOD HAlignment
  45.    METHOD Init          // Initialize the RichText Object
  46.    METHOD IntlTranslate
  47.    METHOD LineSpacing
  48.    METHOD LogicCode
  49.    METHOD NewBase
  50.    METHOD Newfont       // Change the current font
  51.    METHOD NewSection
  52.    METHOD Numcode       // Write an RTF code with a numeric parameter
  53.                         // to the output file
  54.  
  55.    INLINE METHOD OpenGroup()
  56.       Fwrite( ::hFile, "{" )
  57.    RETURN (Self)
  58.  
  59.    METHOD PageNumber
  60.    METHOD PageSetup
  61.    METHOD Paragraph
  62.    METHOD SetFontSize
  63.    METHOD ValToChar
  64.    METHOD Write
  65.    METHOD WriteCell
  66.  
  67.  
  68.    INLINE METHOD TextCode( cCode )
  69.       Fwrite(::hFile, ::FormatCode(cCode) )
  70.    RETURN Self
  71.  
  72.    INLINE METHOD xEnd()
  73.       ::TextCode( "par\pard" )
  74.       ::CloseGroup()
  75.       Fclose(::hFile)
  76.    RETURN Self
  77.  
  78.    INLINE METHOD BeginHeader()
  79.       ::OpenGroup()
  80.       ::TextCode("header \pard")
  81.    Return Self
  82.  
  83.    INLINE METHOD EndHeader()
  84.       ::TextCode("par")
  85.       ::CloseGroup()
  86.    Return Self
  87.  
  88.    INLINE METHOD BeginFooter()
  89.       ::OpenGroup()
  90.       ::TextCode("footer \pard")
  91.    Return Self
  92.  
  93.    INLINE METHOD EndFooter()
  94.       ::TextCode("par")
  95.       ::CloseGroup()
  96.    Return Self
  97.  
  98.    INLINE METHOD BeginRow()
  99.      ::TextCode( "trowd" )
  100.      ::nCurrRow += 1
  101.    Return Self
  102.  
  103.    INLINE METHOD EndRow()
  104.      ::TextCode( "row" )
  105.    Return Self
  106.  
  107. ENDCLASS
  108.  
  109. * ----------------------------------------------------------------------
  110.   METHOD RichText:Init( cFileName, aFontData, nFontSize, nScale, ;
  111.                         aHigh, lWarn, lGetFile, cPath )
  112. * ----------------------------------------------------------------------
  113. *
  114. * Description:  Initialize the RichText Object
  115. * Arguments:    
  116. * Return:       
  117. *
  118. * ----------------------------------------------------------------------
  119.  
  120. LOCAL i, lOK := .T.
  121. LOCAL cTopFile  := "rtf1\ansi\deff0\deftab720"
  122. LOCAL cColors   := "colortbl\red0\green0\blue0;"
  123. LOCAL cAuthor   := "info\author RichText() Class for Xbase++"
  124. LOCAL cGetTitle := "Enter a File Name for the Report"
  125.  
  126. DEFAULT ;
  127.    cFileName := "REPORT.RTF", ;
  128.    aFontData := { "Courier New" }, ;
  129.    nFontSize := 12, ;
  130.    nScale    := INCH_TO_TWIP, ;
  131.    lWarn     := .F., ;
  132.    lGetFile  := .F.
  133.  
  134.    ::cFileName := cFileName
  135.    ::nFontSize := nFontSize
  136.    ::nScale    := nScale
  137.    ::hFile     := -2
  138.  
  139.    ::lTrimSpaces := .F.
  140.  
  141.    IF VALTYPE(aHigh) == "A"
  142.       ::aTranslate := aHigh
  143.    ELSE
  144.       ::IntlTranslate()
  145.    ENDIF
  146.  
  147.    IF !EMPTY(cPath)
  148.       ::cFileName := cPath + ::cFileName
  149.    ENDIF
  150.  
  151.    IF lGetFile
  152.       ::cFileName := PC_GetSaveFile( ::cFileName )
  153.    ENDIF
  154.  
  155.    IF !EMPTY( ::cFileName )
  156.  
  157.       // If no extension specified in file name, use ".RTF"
  158.       IF !("." $ ::cFileName)
  159.          ::cFileName += ".rtf"
  160.       ENDIF   
  161.  
  162.       IF lWarn .AND. File( ::cFileName )
  163.          lOk := TdYesNo( "File " + PC_DotFile( ::cFileName ) + ;
  164.                 " already exists.  Overwrite?" )
  165.       ENDIF
  166.  
  167.       IF lOk
  168.          // Create/open a file for writing
  169.          ::hFile := FCreate( ::cFileName )
  170.       ENDIF
  171.  
  172.    ELSE
  173.       lOK := .F.
  174.    ENDIF
  175.  
  176.    IF ::hFile >= 0
  177.  
  178.       // Generate RTF file header
  179.  
  180.       // This opens the top-most level group for the report
  181.       // This group must be explicitly closed by the application!
  182.  
  183.       ::OpenGroup()
  184.  
  185.       ::TextCode( cTopFile )
  186.  
  187.       // Generate a font table, and write it to the header
  188.       ::nFontNum := LEN(aFontData)
  189.       ::OpenGroup()
  190.       ::TextCode( "fonttbl" )
  191.       FOR i := 1 TO ::nFontNum
  192.          ::OpenGroup()
  193.          ::NewFont( i )
  194.          ::TextCode( "fnil" )
  195.          ::Write( aFontData[i] + ";" )
  196.          ::CloseGroup()
  197.       NEXT
  198.       ::CloseGroup()
  199.  
  200.       // Use default color info, for now...
  201.       ::OpenGroup()
  202.       ::TextCode( cColors )
  203.       ::CloseGroup()
  204.  
  205.       // Add file author info
  206.       ::OpenGroup()
  207.       ::TextCode( cAuthor )
  208.       ::CloseGroup()
  209.  
  210.       // NOTE:  At this point, we have an open group (the report itself)
  211.       // that must be closed at the end of the report.
  212.  
  213.    ENDIF
  214.  
  215. RETURN (Self)
  216.  
  217. * ----------------------------------------------------------------------
  218.   METHOD RichText:NewFont( nFontNumber )
  219. * ----------------------------------------------------------------------
  220. *
  221. * Description:  Change the current font.
  222. *               Converts app-level font number into RTF font number.
  223. * Arguments:    
  224. * Return:       
  225. *
  226. * ----------------------------------------------------------------------
  227.  
  228.    IF !Empty( nFontNumber ) .AND. nFontNumber <= ::nFontNum
  229.       ::NumCode( "f", nFontNumber-1, .F. )
  230.    ENDIF
  231.  
  232. RETURN (Self)
  233.  
  234. * ----------------------------------------------------------------------
  235.   METHOD RichText:NumCode( cCode, nValue, lScale )
  236. * ----------------------------------------------------------------------
  237. *
  238. * Description:  Write an RTF code with a numeric parameter
  239. *               to the output file
  240. *
  241. *               NOTE: Most RTF numeric measurements must be specified
  242. *               in "Twips" (1/20th of a point, 1/1440 of an inch).
  243. *               However, the interface layer of the RichText class
  244. *               defaults to accept inches.  Therefore, all such
  245. *               measurements must be converted to Twips.
  246. *
  247. * Arguments:    
  248. * Return:
  249. *
  250. * ----------------------------------------------------------------------
  251. LOCAL cWrite := ""
  252.  
  253.    IF Valtype( cCode ) == "C" .AND. Valtype( nValue ) == "N"
  254.  
  255.       cCode := ::FormatCode( cCode )
  256.  
  257.       cWrite += cCode
  258.  
  259.       DEFAULT lScale := .T.
  260.       IF lScale
  261.          nValue := Int( nValue * ::nScale )
  262.       ENDIF
  263.       cWrite += Alltrim( str( nValue ) )
  264.  
  265.       FWrite(::hFile, cWrite )
  266.  
  267.    ENDIF
  268.  
  269. RETURN (Self)
  270.  
  271. * ----------------------------------------------------------------------
  272.   METHOD RichText:Write( xData, lCodesOK )
  273. * ----------------------------------------------------------------------
  274. *********************************************************************
  275. * Description:  Write data to output file, accounting for any characters
  276. *               above ASCII 127 (RTF only deals with 7-bit characters
  277. *               directly) -- 8-bit characters must be handled as hex data.
  278. * Arguments:    
  279. * Return:       
  280. *               
  281. *--------------------------------------------------------------------
  282. * Date       Developer   Comments
  283. * 01/06/97   TRM         Creation
  284. *********************************************************************
  285. LOCAL cWrite := ""
  286. LOCAL i, cChar, nChar
  287. LOCAL cString := ::ValToChar( xData )
  288. LOCAL aCodes := { "\", "{", "}" }
  289. LOCAL aReturn := { CHR(13), CHR(10) }
  290.  
  291. DEFAULT lCodesOK := .F.
  292.  
  293. IF ::lTrimSpaces
  294.     cString := RTRIM( cString )
  295. ENDIF
  296.  
  297. //cString := " " + cString
  298.  
  299. FOR i := 1 TO LEN(cString)
  300.  
  301.     cChar := SUBSTR(cString, i, 1)
  302.     nChar := ASC(cChar)
  303.  
  304.     IF nChar < 128
  305.  
  306.         IF nChar > 91
  307.  
  308.             // Process special RTF symbols
  309.             IF !lCodesOK
  310.                 IF ASCAN( aCodes, cChar ) > 0
  311.                     cChar := "\" + cChar
  312.                 ENDIF
  313.             ENDIF
  314.  
  315.         ELSEIF nChar < 33
  316.  
  317.             // 7/9/97
  318.             // 1. Don't convert hard returns to "\par" if we're processing
  319.             //    RTF data (i.e., lCodesOK), since some RTF's have
  320.             //    stray returns in them.
  321.             // 2. Convert all tabs to "\tab", since MS-Word doesn't like CHR(9)'s
  322.  
  323.             IF !lCodesOK .AND. nChar == 13 // Turn carriage returns into new paragraphs
  324.                 cChar := "\par " 
  325.             ELSEIF nChar == 9 // 7/9/97 -- Convert tabs
  326.                 cChar := "\tab "
  327.             ELSEIF nChar == 10 // Ignore line feeds
  328.                 LOOP
  329.             ENDIF
  330.  
  331.         ENDIF
  332.  
  333.         cWrite += cChar
  334.  
  335.  
  336.     ELSE
  337.  
  338.         // We have a high-order character, which is a no-no in RTF.
  339.         // If no international translation table for high-order characters
  340.         // is specified, write data verbatim in hex format.  If a
  341.         // translation table is specified, look up the appropriate
  342.         // hex value to write.
  343.  
  344.         IF EMPTY( ::aTranslate )
  345.             // Ignore soft line breaks
  346.             IF nChar == 141
  347.                 LOOP
  348.             ELSE
  349.                 cWrite += "'" + LOWER( ::NewBase( nChar, 16 ) )
  350.             ENDIF
  351.         ELSE
  352.             cWrite += ::aTranslate[ ASC(cChar)-127 ]
  353.         ENDIF
  354.  
  355.     ENDIF
  356.  
  357. NEXT
  358.  
  359. ::OpenGroup()
  360. FWRITE(::hFile, cWrite )
  361. ::CloseGroup()
  362.  
  363. *************************  END OF Write()  **************************
  364. RETURN self
  365.  
  366.  
  367. METHOD RichText:ValToChar( x )
  368.  
  369.    IF valtype( x ) == "C"
  370.  
  371.       RETURN ( x )
  372.  
  373.    ELSEIF valtype( x ) == "M"
  374.  
  375.       RETURN ( memotran( x, chr(13)+chr(10), " " ) )
  376.  
  377.    ELSEIF valtype( x ) == "N"
  378.  
  379.       RETURN alltrim( str( x ) )
  380.  
  381.    ELSEIF valtype( x ) == "D"
  382.  
  383.       RETURN dtoc( x )
  384.  
  385.    ELSEIF valtype( x ) == "L"
  386.   
  387.       Return if( x, ".T.", ".F." )
  388.  
  389.    ENDIF
  390.  
  391. RETURN ( "Error in function cValtype" )
  392.  
  393. METHOD RichText:NewBase( nDec, nBase )
  394. *********************************************************************
  395. * Description:  Convert a decimal numeric to a string in another
  396. *               base system
  397. * Arguments:    
  398. * Return:       
  399. *               
  400. *--------------------------------------------------------------------
  401. * Date       Developer   Comments
  402. * 01/12/97   TRM         Creation
  403. *
  404. *********************************************************************
  405. LOCAL cNewBase := "", nDividend, nRemain, lContinue := .T., cRemain
  406.  
  407. DO WHILE lContinue
  408.  
  409.     nDividend := INT( nDec / nBase )
  410.     nRemain := nDec % nBase
  411.  
  412.     IF nDividend >= 1
  413.         nDec := nDividend
  414.     ELSE
  415.         lContinue := .F.
  416.     ENDIF
  417.  
  418.     IF nRemain < 10
  419.         cRemain := ALLTRIM(STR(nRemain,2,0))
  420.     ELSE    
  421.         cRemain := CHR( nRemain + 55 )
  422.     ENDIF
  423.  
  424.     cNewBase := cRemain + cNewBase
  425.  
  426. ENDDO
  427.  
  428. RETURN cNewBase
  429. ************************  END OF NewBase()  *************************
  430.  
  431.  
  432. METHOD RichText:FormatCode( cCode )
  433. *********************************************************************
  434. * Description:  Remove extraneous spaces from a code, and make sure
  435. *               that it has a leading backslash ("\").
  436. * Arguments:    
  437. * Return:       
  438. *               
  439. *--------------------------------------------------------------------
  440. * Date       Developer   Comments
  441. * 01/12/97   TRM         Creation
  442. *
  443. *********************************************************************
  444. cCode := ALLTRIM(cCode)
  445. IF !( LEFT(cCode, 1) == "\" )
  446.     cCode := "\" + cCode
  447. ENDIF
  448.  
  449. RETURN cCode
  450. ***********************  END OF FormatCode()  ***********************
  451.  
  452. * ----------------------------------------------------------------------
  453.   METHOD RichText:PageSetup( nLeft, nRight, nTop, nBottom, nWidth, nHeight, ;
  454.                 nTabWidth, lLandscape, lNoWidow, cVertAlign, ;
  455.                 cPgNumPos, lPgNumTop )
  456. * ----------------------------------------------------------------------
  457. *********************************************************************
  458. * Description:  Define default page setup info for file
  459. *               This information is placed in the "document formatting
  460. *               group" of the RTF file, except for vertical alignment,
  461. *               which, if supplied, is treated as a new section.
  462. * Arguments:    
  463. * Return:       
  464. * ----------------------------------------------------------------------
  465. DEFAULT lLandscape := .F.
  466. DEFAULT lNoWidow := .F.
  467. DEFAULT lPgNumTop := .F.
  468.  
  469.  
  470. // Note -- "landscape" should not be specified here if landscape and
  471. // portrait orientations are to be mixed.  If "landscape' is specified,
  472. // the paper width and height should also be specified, and consistent
  473. // (i.e., with landscape/letter, width==11 and height==8.5)
  474.  
  475. ::LogicCode( "landscape", lLandscape )
  476. ::NumCode( "paperw", nWidth )
  477. ::NumCode( "paperh", nHeight )
  478.  
  479. ::LogicCode( "widowctrl", lNoWidow )
  480. ::NumCode( "margl", nLeft )
  481. ::NumCode( "margr", nRight )
  482. ::NumCode( "margt", nTop )
  483. ::NumCode( "margb", nBottom )
  484. ::NumCode( "deftab", nTabWidth )
  485.  
  486.  
  487. // Vertical alignment and page number position are "section-specific"
  488. // codes.  But we'll put them here anyway for now...
  489.  
  490. IF !EMPTY( cVertAlign )
  491.     ::TextCode( "vertal" + LOWER( LEFT(cVertAlign,1) ) )
  492. ENDIF
  493.  
  494. // Set the initial font size
  495. ::SetFontSize(::nFontSize)
  496.  
  497. // Forget page numbers for now...
  498.  
  499.  
  500. RETURN Self
  501.  
  502. **********************  END OF PageSetup()  *************************
  503.  
  504. * ----------------------------------------------------------------------
  505.   METHOD RichText:LogicCode( cCode, lTest )
  506. * ----------------------------------------------------------------------
  507. *
  508. * Description:  Write an RTF code if the supplied value is true
  509. *
  510. * Arguments:    
  511. * Return:       
  512. *               
  513. * ----------------------------------------------------------------------
  514. IF VALTYPE(cCode) == "C" .AND. VALTYPE(lTest) == "L"
  515.     IF lTest
  516.         ::TextCode( cCode )
  517.     ENDIF
  518. ENDIF
  519.  
  520. RETURN Self
  521.  
  522. ***********************  END OF LogicCode()  *************************
  523.  
  524. * ----------------------------------------------------------------------
  525.   METHOD RichText:SetFontSize( nFontSize )
  526. * ----------------------------------------------------------------------
  527. *
  528. * Description:    Size in points -- must double value because
  529. *                 RTF font sizes are expressed in half-points
  530. * Arguments:    
  531. * Return:       
  532. *               
  533. * ----------------------------------------------------------------------
  534.  
  535. IF VALTYPE( nFontSize ) == "N"
  536.     ::nFontSize := nFontSize
  537.     ::NumCode( "fs", ::nFontSize*2, .F. )
  538. ENDIF
  539.  
  540. RETURN Self
  541. **********************  END OF SetFontSize()  ***********************
  542.  
  543. * ----------------------------------------------------------------------
  544.   METHOD RichText:Paragraph( cText, nFontNumber, nFontSize, cAppear, ;
  545.         cHorzAlign, aTabPos, nIndent, nFIndent, nRIndent, nSpace, ;
  546.         lSpExact, nBefore, nAfter, lNoWidow, lBreak, ;
  547.         lBullet, cBulletChar, lHang, lDefault, lNoPar, ;
  548.         nTCLevel )
  549. * ----------------------------------------------------------------------
  550. *
  551. * Description:  Write a new, formatted paragraph to the output file.
  552. * Arguments:    
  553. * Return:       
  554. *
  555. * ----------------------------------------------------------------------
  556. DEFAULT ;
  557.     lDefault := .F., ;
  558.     lNoWidow := .F., ;
  559.     lBreak := .F., ;
  560.     lBullet := .F., ;
  561.     lHang := .F., ;
  562.     cAppear := "", ;
  563.     cHorzAlign := "", ;
  564.     cBulletChar := "\bullet", ;
  565.     lNoPar := .F.
  566.  
  567. ::LogicCode("pagebb", lBreak)
  568.  
  569. IF !lNoPar
  570.     ::TextCode( "par" )
  571. ENDIF
  572.  
  573. ::LogicCode( "pard", lDefault )
  574. ::NewFont( nFontNumber )
  575. ::SetFontSize( nFontSize )
  576. ::Appearance( cAppear )
  577. ::HAlignment( cHorzAlign )
  578.  
  579. IF VALTYPE( aTabPos ) == "A"
  580.     AEVAL( aTabPos, { |x| ::NumCode("tx", x) } )
  581. ENDIF
  582.  
  583. ::NumCode( "li", nIndent )
  584. ::NumCode( "fi", nFIndent )
  585. ::NumCode( "ri", nRIndent )
  586. ::LineSpacing( nSpace, lSpExact )
  587.  
  588. ::NumCode( "sb", nBefore )
  589. ::NumCode( "sa", nAfter )
  590.  
  591. ::LogicCode("keep", lNoWidow)
  592.  
  593. IF lBullet
  594.     ::OpenGroup()
  595.         ::TextCode( "*" )
  596.         ::TextCode( "pnlvlblt" )
  597.         ::LogicCode( "pnhang", lHang )
  598.         ::TextCode( "pntxtb " + cBulletChar )
  599.     ::CloseGroup()
  600. ENDIF
  601.  
  602. ::Write( cText )
  603.  
  604. // 7/9/97
  605. IF VALTYPE( nTCLevel ) == "N"
  606.     ::OpenGroup()
  607.         ::TextCode( "v" ) // this hides the following text
  608.         ::TextCode( "tc" )
  609.         ::Write( cText )
  610.         ::NumCode( "tcl", nTCLevel, .F. )
  611.     //    ::TextCode( "v0" ) // this turns off hidden attribute
  612.     ::CloseGroup()
  613. ENDIF
  614.  
  615. RETURN Self
  616. **********************  END OF Paragraph()  *************************
  617.  
  618. * ----------------------------------------------------------------------
  619.   METHOD RichText:Appearance( cAppear )
  620. * ----------------------------------------------------------------------
  621. * Description:  Change the "appearance" (bold, italic, etc.)
  622. *               Appearance codes are concatenable at the app-level
  623. *               and already contain backslashes.
  624. * Arguments:    
  625. * Return:       
  626. *
  627. * ----------------------------------------------------------------------
  628.  
  629. // Special case (see .CH file) -- first remove leading slash ...ugh.
  630. IF !EMPTY(cAppear)
  631.     ::TextCode( SUBSTR(cAppear, 2) )
  632. ENDIF
  633.  
  634. RETURN Self
  635. ***********************  END OF Appearance()  ***********************
  636.  
  637. * ----------------------------------------------------------------------
  638.   METHOD RichText:HAlignment( cAlign )
  639. * ----------------------------------------------------------------------
  640. *
  641. * Description:  Change the horizontal alignment
  642. * Arguments:    
  643. * Return:       
  644. *
  645. * ----------------------------------------------------------------------
  646. IF !EMPTY(cAlign)
  647.     ::TextCode( "q" + LOWER(LEFT(cAlign,1)) )
  648. ENDIF
  649.  
  650. RETURN Self
  651. **********************  END OF HAlignment()  ************************
  652.  
  653. * ----------------------------------------------------------------------
  654.   METHOD RichText:LineSpacing( nSpace, lSpExact )
  655. * ----------------------------------------------------------------------
  656. *
  657. * Description:  Change the line spacing (spacing can either be "exact"
  658. *               or "multiple" (of single spacing).  If exact, the units
  659. *               of the supplied value must be converted to twips.
  660. * Arguments:    
  661. * Return:       
  662. *               
  663. * ----------------------------------------------------------------------
  664. DEFAULT lSpExact := .F.
  665.  
  666. ::NumCode( "sl", nSpace, lSpExact )
  667. IF !EMPTY( nSpace )
  668.     ::NumCode( "slmult", IIF( lSpExact, 0, 1 ), .F. )
  669. ENDIF
  670.  
  671. RETURN Self
  672. **********************  END OF LineSpacing()  ***********************
  673.  
  674. * ----------------------------------------------------------------------
  675.   METHOD RichText:PageNumber( cHorzAlign )
  676. * ----------------------------------------------------------------------
  677. *
  678. * Description:  Insert a page number field.
  679. *               Best used within headers and footers.
  680. * Arguments:    
  681. * Return:       
  682. *
  683. * ----------------------------------------------------------------------
  684.  
  685. DEFAULT cHorzAlign := ""
  686.  
  687. ::OpenGroup()
  688.  
  689.     ::HAlignment( cHorzAlign ) // not sure if this works
  690.  
  691.     ::TextCode( "field" )
  692.     ::OpenGroup()
  693.         ::TextCode( "*\fldinst PAGE  \" )
  694.         ::TextCode( "* MERGEFORMAT  " )
  695.     ::CloseGroup()
  696.     ::OpenGroup()
  697.         ::TextCode( "fldrslt " ) // don't include a result for now
  698.     ::CloseGroup()
  699. ::CloseGroup()
  700.  
  701.  
  702. RETURN Self
  703. ************************  END  OF PageNumber()  *********************
  704.  
  705. * ----------------------------------------------------------------------
  706.   METHOD RichText:NewSection( lLandscape, nColumns, nLeft, nRight, nTop, nBottom, ;
  707.                 nWidth, nHeight, cVertAlign, lDefault )
  708. * ----------------------------------------------------------------------
  709. *
  710. * Description:  Open a new section, with optional new formatting
  711. *               properties.
  712. *               
  713. * Arguments:    
  714. * Return:       
  715. *               
  716. * ----------------------------------------------------------------------
  717. DEFAULT lDefault := .F.
  718.  
  719. //::OpenGroup()
  720. ::TextCode( "sect" )
  721.  
  722. IF lDefault
  723.     ::TextCode( "sectd" )
  724. ENDIF
  725.  
  726. ::LogicCode( "lndscpsxn", lLandscape )
  727. ::NumCode( "cols", nColumns, .F. )
  728. ::NumCode( "marglsxn", nLeft )
  729. ::NumCode( "margrsxn", nRight )
  730. ::NumCode( "margtsxn", nTop )
  731. ::NumCode( "margbsxn", nBottom )
  732. ::NumCode( "pgwsxn", nWidth )
  733. ::NumCode( "pghsxn", nHeight )
  734.  
  735. IF !EMPTY( cVertAlign )
  736.     ::TextCode( "vertal" + LOWER( LEFT(cVertAlign,1) ) )
  737. ENDIF
  738.  
  739. RETURN Self
  740. ***********************  END OF NewSection()  **********************
  741.  
  742. * ----------------------------------------------------------------------
  743.   METHOD RichText:DefineTable( cTblHAlign, nTblFntNum, nTblFntSize, ;
  744.         cCellAppear, cCellHAlign, nTblRows, ;
  745.         nTblColumns, nTblRHgt, aTableCWid, cRowBorder, cCellBorder, nCellPct, ;
  746.         lTblNoSplit, nTblHdRows, nTblHdHgt, nTblHdPct, nTblHdFont, ;
  747.         nTblHdFSize, cHeadAppear, cHeadHAlign )
  748. * ----------------------------------------------------------------------
  749. *
  750. * Description:  Define the default setup for a table.
  751. *               This simply saves the parameters to the object's
  752. *               internal instance variables.
  753. * Arguments:    
  754. * Return:       
  755. *               
  756. * ----------------------------------------------------------------------
  757. LOCAL i
  758. DEFAULT ;
  759.     cTblHAlign := "CENTER", ;
  760.     nTblFntNum := 1, ;
  761.     nTblFntSize := ::nFontSize, ;
  762.     nTblRows := 1, ;
  763.     nTblColumns:= 1, ;
  764.     nTblRHgt := NIL, ;
  765.     aTableCWid := ARRAY(nTblColumns), ; // see below
  766.     cRowBorder := "NONE", ;
  767.     cCellBorder := "SINGLE", ;
  768.     nCellPct := 0, ;
  769.     lTblNoSplit := .F., ;
  770.     nTblHdRows := 0, ;
  771.     nTblHdHgt := nTblRHgt, ;
  772.     nTblHdPct := .1, ;
  773.     nTblHdFont := nTblFntNum, ;
  774.     nTblHdFSize := ::nFontSize + 2
  775.  
  776.     IF aTableCWid[1] == NIL
  777.         AFILL( aTableCWid, 6.5/nTblColumns )
  778.     ELSEIF VALTYPE(aTableCWid[1]) == "A"
  779.         aTableCWid := ACLONE(aTableCWid[1])
  780.     ENDIF
  781.  
  782.     // Turn independent column widths into "right boundary" info...
  783.     FOR i := 2 TO LEN( aTableCWid )
  784.         aTableCWid[i] += aTableCWid[i-1]
  785.     NEXT
  786.  
  787. ::cTblHAlign := LOWER( LEFT(cTblHAlign, 1) )
  788. ::nTblFntNum := nTblFntNum
  789. ::nTblFntSize := nTblFntSize
  790. ::cCellAppear := cCellAppear
  791. ::cCellHAlign := cCellHAlign
  792. ::nTblRows := nTblRows
  793. ::nTblColumns:= nTblColumns
  794. ::nTblRHgt := nTblRHgt
  795. ::aTableCWid := aTableCWid
  796. ::cRowBorder := ::BorderCode( cRowBorder )
  797. ::cCellBorder := ::BorderCode( cCellBorder )
  798. ::nCellPct := IIF( nCellPct < 1, nCellPct*10000, nCellPct*100 )
  799. ::lTblNoSplit := lTblNoSplit
  800. ::nTblHdRows := nTblHdRows
  801. ::nTblHdHgt := nTblHdHgt
  802. ::nTblHdPct := IIF( nTblHdPct < 1, nTblHdPct*10000, nTblHdPct*100 )
  803. ::nTblHdFont := nTblHdFont
  804. ::nTblHdFSize := nTblHdFSize
  805. ::cHeadAppear := cHeadAppear
  806. ::cHeadHAlign := cHeadHAlign
  807.  
  808. ::nCurrColumn := 0
  809. ::nCurrRow    := 0
  810.  
  811. RETURN Self
  812. **********************  END OF DefineTable()  ***********************
  813.  
  814. * ----------------------------------------------------------------------
  815.   METHOD RichText:BorderCode( cBorderID )
  816. * ----------------------------------------------------------------------
  817. *
  818. * Description:  Convert an application-level border ID into
  819. *               a valid RTF border code.
  820. * Arguments:    
  821. * Return:       
  822. *               
  823. * ----------------------------------------------------------------------
  824. LOCAL cBorderCode := "", n
  825. LOCAL aBorder := ;
  826.     { ;
  827.     { "NONE",        NIL   }, ;
  828.     { "SINGLE",      "s"   }, ;
  829.     { "DOUBLETHICK", "th"  }, ;
  830.     { "SHADOW",      "sh"  }, ;
  831.     { "DOUBLE",      "db"  }, ;
  832.     { "DOTTED",      "dot" }, ;
  833.     { "DASHED",      "dash"}, ;
  834.     { "HAIRLINE",    "hair"}  ;
  835.     }
  836.  
  837. cBorderID := UPPER( RTRIM(cBorderID) )
  838.  
  839. n := ASCAN( aBorder, { |x| x[1] == cBorderID } ) 
  840.  
  841. IF n > 0
  842.     cBorderCode := aBorder[n][2]
  843. ENDIF
  844.  
  845. RETURN cBorderCode
  846. ************************  END  OF BorderCode()  *********************
  847.  
  848. * ----------------------------------------------------------------------
  849.   METHOD RichText:WriteCell( cText, nFontNumber, nFontSize, cAppear, cHorzAlign, ;
  850.                 nSpace, lSpExact, cCellBorder, nCellPct, lDefault, ;
  851.                 lMrgColumns, nMrgColumns )
  852. * ----------------------------------------------------------------------
  853. *
  854. * Description:  Write a formatted cell of data to the current row
  855. *               of the current table.  Also takes care of the logic
  856. *               required for headers & header formatting.
  857. * Arguments:    
  858. * Return:       
  859. *               
  860. * ----------------------------------------------------------------------
  861. LOCAL i
  862.  
  863. DEFAULT ;
  864.     cText := "", ;
  865.     lDefault := .F., ;
  866.     lMrgColumns := .F., ;
  867.     nMrgColumns := ::nTblColumns
  868.  
  869. // Increment/reset the column #
  870. IF ::nCurrColumn == ::nTblColumns
  871.     ::nCurrColumn := 1
  872. ELSE
  873.     ::nCurrColumn += 1
  874. ENDIF
  875.  
  876.  
  877. // Apply any one-time formatting for header/body
  878.  
  879. IF ::nCurrColumn == 1
  880.  
  881.     IF ::nCurrRow == 0 .AND. ::nTblHdRows > 0
  882.  
  883.         // Start a separate group for the header rows
  884.         ::OpenGroup()
  885.         ::BeginRow()
  886.  
  887.         // We need to apply header formats
  888.         // The "\trgaph108" & "trleft-108" are the defaults used by MS-Word,
  889.         // so if it's good enough for Word, it's good enough for me...
  890.  
  891.         ::TextCode( "trgaph108\trleft-108" )
  892.         ::TextCode( "trq" + ::cTblHAlign )
  893.         ::Borders( "tr", ::cRowBorder )
  894.         ::NumCode( "trrh", ::nTblHdHgt )
  895.         ::TextCode( "trhdr" )
  896.         ::LogicCode( "trkeep", ::lTblNoSplit )
  897.  
  898.         // Set the default border & width info for each header cell
  899.         FOR i := 1 TO LEN( ::aTableCWid )
  900.             ::NumCode( "clshdng", ::nTblHdPct, .F. )
  901.             ::Borders( "cl", ::cCellBorder )
  902.             ::NumCode("cellx", ::aTableCWid[i] )
  903.         NEXT
  904.  
  905.         // Identify the header-specific font
  906.         ::NewFont( ::nTblHdFont )
  907.         ::SetFontSize( ::nTblHdFSize )
  908.         ::Appearance( ::cHeadAppear )
  909.         ::HAlignment( ::cHeadHAlign )
  910.  
  911.         ::TextCode( "intbl" )
  912.  
  913.     ELSEIF ::nCurrRow == ::nTblHdRows
  914.  
  915.         // The header rows are over,
  916.         // so we need to apply formats to the body of the table.
  917.  
  918.         // First close the header section, if one exists
  919.         IF ::nTblHdRows > 0
  920.             ::EndRow()
  921.             ::CloseGroup()
  922.         ENDIF
  923.  
  924.         ::BeginRow()
  925.         ::TextCode( "trgaph108\trleft-108" )
  926.         ::TextCode( "trq" + ::cTblHAlign )
  927.         ::Borders( "tr", ::cRowBorder )
  928.         ::NumCode( "trrh", ::nTblRHgt )
  929.         ::LogicCode( "trkeep", ::lTblNoSplit )
  930.  
  931.         // Set the default shading, border & width info for each body cell
  932.         FOR i := 1 TO LEN( ::aTableCWid )
  933.             ::NumCode( "clshdng", ::nCellPct, .F. )
  934.             ::Borders( "cl", ::cCellBorder )
  935.             ::NumCode("cellx", ::aTableCWid[i] )
  936.         NEXT
  937.  
  938.         // Write the body formatting codes
  939.         ::NewFont( ::nTblFntNum )
  940.         ::SetFontSize( ::nTblFntSize )
  941.         ::Appearance( ::cCellAppear )
  942.         ::HAlignment( ::cCellHAlign )
  943.  
  944.         ::TextCode( "intbl" )
  945.  
  946.     ELSE
  947.  
  948.         // End of a row of the table body.
  949.         ::EndRow()
  950.  
  951.         // Prepare the next row for inclusion in table
  952.         ::TextCode( "intbl" )
  953.  
  954.     ENDIF
  955.  
  956. ENDIF
  957.  
  958.  
  959.  
  960. // Apply any cell-specific formatting, and write the text
  961.  
  962. ::OpenGroup()
  963.  
  964.     ::LogicCode( "pard", lDefault )
  965.     ::NewFont( nFontNumber )
  966.     ::SetFontSize( nFontSize )
  967.     ::Appearance( cAppear )
  968.     ::HAlignment( cHorzAlign )
  969.     ::LineSpacing( nSpace, lSpExact )
  970.     ::Borders( "cl", cCellBorder )
  971.     ::NumCode( "clshdng", nCellPct, .F. )
  972.  
  973.     // Now write the text
  974.     ::Write( cText )
  975.  
  976. ::CloseGroup()
  977.  
  978. // Close the cell
  979. ::TextCode( "cell" )
  980.  
  981. RETURN Self
  982. ***********************  END OF WriteCell()  ************************
  983.  
  984. * ----------------------------------------------------------------------
  985.   METHOD RichText:Borders( cEntity, cBorder )
  986. * ----------------------------------------------------------------------
  987. *
  988. * Description:  Apply borders to rows or cells.  Currently limited to
  989. *               one type of border per rectangle.
  990. * Arguments:    
  991. * Return:       
  992. *
  993. * ----------------------------------------------------------------------
  994. LOCAL i, aBorder := { "t", "b", "l", "r" }
  995.  
  996. IF VALTYPE( cBorder ) == "C"
  997.     FOR i := 1 TO 4
  998.         ::TextCode( cEntity + "brdr" + aBorder[i] + "\brdr" + cBorder )
  999.     NEXT
  1000. ENDIF
  1001.  
  1002. RETURN Self
  1003. ************************  END OF Borders()  *************************
  1004.  
  1005. FUNCTION RTFMerge( cPriFile, nSkip, xRTF, cClipDelims )
  1006. *********************************************************************
  1007. * Description:  Merge data into the format specified in <cPriFile>,
  1008. *               which contains Clipper expressions delimited by
  1009. *               <cClipDelims>.  The intent is that <cPriFile> will
  1010. *               be an RTF file, though it doesn't have to be.
  1011. *
  1012. *               <nSkip> specifies the number of bytes to skip at
  1013. *               the top of the file, before reading the merge data.
  1014. *               This allows you to skip the RTF header, for example,
  1015. *               so that the merged output doesn't have multiple headers.
  1016. *
  1017. *               <xRTF> may be either a RichText() object, or just an
  1018. *               open file handle.
  1019. *
  1020. *               <cClipDelims> defaults to "<[]>".  If specified, it
  1021. *               must be exactly 4 characters (4 make it easier to
  1022. *               specify unique delimiters).  The first two bytes
  1023. *               specify the opening delimiter, and the last two specify
  1024. *               the closing delimiter. These are the delimiters that
  1025. *               must be used in <cPriFile> to designate Clipper
  1026. *               expressions.  For example <[Myarea->Name]>, or
  1027. *               <[DBSKIP()]>.  The supplied expressions must be
  1028. *               macro-compilable.  Currently, no error handling is
  1029. *               supplied for bad expressions.
  1030. *               
  1031. *               Inspired by a request from Michael Mozina on the
  1032. *               Compuserve Clipper Forum.
  1033. *               
  1034. * Arguments:    
  1035. * Return:       
  1036. *               
  1037. *--------------------------------------------------------------------
  1038. * Date       Developer   Comments
  1039. * 02/02/97   TRM         Creation
  1040. *
  1041. *********************************************************************
  1042. LOCAL hPriFile, aDelims, cBuffer := "", cPrevBuff := "", cOrigBuff := ""
  1043. LOCAL nCurrCode := 0, cExpr := "", lCodeTest
  1044. LOCAL lRTF := VALTYPE(xRTF) == "O"
  1045. LOCAL xEval
  1046. LOCAL nRead := 0, nTotBytes := 0
  1047.  
  1048. DEFAULT cClipDelims := "<[]>"
  1049.  
  1050. hPriFile := FOPEN( cPriFile )
  1051.  
  1052. IF hPriFile < 0
  1053.     TdMsg( "Could not open primary merge file: " + PC_DotFile(cPriFile) + "." )
  1054. ELSE
  1055.  
  1056.     IF !( LEN(cCLipDelims) == 4 )
  1057.  
  1058.         TdMsg( "Bad delimiters specified for merge file." )
  1059.  
  1060.     ELSE
  1061.  
  1062.         // File is open, and delimiters are OK, so let's move forward.
  1063.  
  1064.         // See how many bytes we have.
  1065.         nTotBytes := FSEEK( hPriFile, 0, 2 )
  1066.  
  1067.         // Reposition to the top of the file.
  1068.         FSEEK( hPriFile, 0, 0 )
  1069.  
  1070.         // If an initial offset is specified, process it.
  1071.         // For RTF's, this is used to skip the header.
  1072.         IF VALTYPE( nSkip ) == "N"
  1073.             nRead := FSEEK( hPriFile, nSkip )
  1074.         ENDIF
  1075.  
  1076.         // Dump the delimiters into an array.
  1077.         aDelims := ;
  1078.             { ;
  1079.             SUBSTR( cClipDelims, 1, 1 ), ;
  1080.             SUBSTR( cClipDelims, 2, 1 ), ;
  1081.             SUBSTR( cClipDelims, 3, 1 ), ;
  1082.             SUBSTR( cClipDelims, 4, 1 )  ;
  1083.             }
  1084.  
  1085.         // Loop through primary merge file.
  1086.         // For RTF's, we want to stop one byte before the end.
  1087.  
  1088.         DO WHILE nRead < nTotBytes-1
  1089.  
  1090.             ++nRead
  1091.  
  1092.             cBuffer := FREADSTR( hPriFile, 1 )
  1093.             cOrigBuff := cBuffer
  1094.  
  1095.             // If we think we're reading a Clipper expression,
  1096.             // this determines if we've encountered the next
  1097.             // expected part of the sequence.
  1098.  
  1099.             lCodeTest := ( cBuffer == aDelims[nCurrCode+1] )
  1100.  
  1101.             IF lCodeTest
  1102.  
  1103.                 // We have met a delimiter for a Clipper expression
  1104.  
  1105.                 IF nCurrCode < 3
  1106.                     ++nCurrCode
  1107.                 ELSE
  1108.  
  1109.                     // We have completed the Clipper expression, so let's
  1110.                     // evaluate it and dump the result to the output file.
  1111.  
  1112.                     // First remove extraneous spaces.
  1113.                     cExpr := ALLTRIM( cExpr )
  1114.  
  1115.                     // Now macro compile & evaluate it.
  1116.                     // [NOTE: An error trap for bad expressions would be a nice
  1117.                     // touch someday -- but this is "proof of concept" right now].
  1118.  
  1119.                     // eventually, set error handler to catch bad expressions...
  1120.                     xEval := EVAL( { || &cExpr } )
  1121.                     // ...reset original error handler
  1122.  
  1123.                     // If the expression returns a character value, we interpret
  1124.                     // it as text; otherwise, we just move on.  This allows us to
  1125.                     // embed directions like "DBSKIP()" in the primary file.
  1126.  
  1127.                     IF VALTYPE( xEval ) == "C"
  1128.                         cBuffer := xEval
  1129.                     ELSE
  1130.                         cBuffer := ""
  1131.                     ENDIF
  1132.  
  1133.                     // Reset the placeholder & flags for the next expression.
  1134.                     cExpr   := ""
  1135.                     nCurrCode := 0
  1136.                     lCodeTest := .F.
  1137.  
  1138.                 ENDIF
  1139.  
  1140.             ELSE
  1141.  
  1142.                 // It's not a valid delimiter, or is out of sequence.
  1143.                 // If we were expecting the second in a two-character sequence,
  1144.                 // we have to treat the first character as simple data now.
  1145.  
  1146.                 IF nCurrCode == 1 .OR. nCurrcode == 3
  1147.                     --nCurrCode
  1148.                     cBuffer := cPrevBuff + cBuffer
  1149.                 ENDIF
  1150.  
  1151.             ENDIF
  1152.  
  1153.             // If it wasn't a non-terminating code, we write
  1154.             // the data to the output file.
  1155.             // We either have "constant" data, or part of a
  1156.             // Clipper expression.
  1157.  
  1158.             IF !lCodeTest
  1159.                 IF nCurrCode == 2
  1160.                     // We're in the process of reading a Clipper expression,
  1161.                     // so just add to it.
  1162.                     cExpr += cBuffer
  1163.                 ELSE
  1164.                     // We have constant data, so just pass it to the output.
  1165.                     IF lRTF
  1166.                         // If we're reading an RTF file, we allow RTF codes
  1167.                         // in the output, as-is (second parameter is .T.).
  1168.                         xRTF:Write( cBuffer, .T. )
  1169.                     ELSE
  1170.                         // If not an RTF, just write the output directly
  1171.                         FWRITE( xRTF, cBuffer )
  1172.                     ENDIF
  1173.                 ENDIF
  1174.             ENDIF
  1175.  
  1176.             cPrevBuff := cOrigBuff
  1177.  
  1178.         ENDDO
  1179.  
  1180.     ENDIF
  1181.  
  1182.     FCLOSE( hPriFile )
  1183.  
  1184. ENDIF
  1185.  
  1186. RETURN NIL
  1187. **************************  END  OF RTFMerge()  ***********************
  1188.  
  1189. FUNCTION RTFHeader( cFile )
  1190. *********************************************************************
  1191. * Description:  Return the header portion of an RTF file.  If the
  1192. *               return value is empty, it's not an RTF.
  1193. *
  1194. *               This algorithm is not fool-proof, but it's good
  1195. *               enough to handle most real-world RTFs.
  1196. *
  1197. * Arguments:    
  1198. * Return:       
  1199. *               
  1200. *--------------------------------------------------------------------
  1201. * Date       Developer   Comments
  1202. * 02/05/97   TRM         Creation
  1203. *
  1204. *********************************************************************
  1205. LOCAL hFile
  1206. LOCAL cBuffer := ""
  1207. LOCAL cCurrCmd := ""
  1208. LOCAL nGrpLevel := 0, nGrpCmd := 0
  1209. LOCAL nRealBytes := 0, nRead := 0
  1210. LOCAL aHeadCmd := ;
  1211.     { "\rtf", "\colortbl", "\fonttbl", "\info", ;
  1212.       "\filetbl", "\stylesheet", "\revtbl" }
  1213.  
  1214. LOCAL nTest := 0
  1215.  
  1216. IF IsRTF( cFile )
  1217.  
  1218.     hFile := FOPEN( cFile )
  1219.  
  1220.     DO WHILE .T.
  1221.  
  1222.         cBuffer := FREADSTR(hFile, 1)
  1223.         IF cBuffer == ""
  1224.             EXIT
  1225.         ENDIF
  1226.         ++nRead
  1227.  
  1228.         IF cBuffer $ "{}\; "
  1229.  
  1230.             // If currently parsing an RTF command, terminate it.
  1231.  
  1232.             IF !EMPTY( cCurrCmd )
  1233.  
  1234.                 // We're done if this is the first command in a group,
  1235.                 // but the command is not a standard header command.
  1236.                 // NOTE: This logic assumes that there is at least one
  1237.                 // valid header group after the "\rtf..." sequence.
  1238.                 // It also assumes that the first command in a header group
  1239.                 // is the group identifier
  1240.  
  1241.                 IF nGrpLevel < 2 .AND. nGrpCmd == 1 .AND. ;
  1242.                     ASCAN( aHeadCmd, cCurrCmd ) == 0 .AND. ;
  1243.                     LEFT( cCurrCmd, 4 ) != aHeadCmd[1]
  1244.  
  1245.                     // This is not a valid header group, so we assume that
  1246.                     // the header is complete, and quit.
  1247.                     EXIT
  1248.  
  1249.                 ENDIF
  1250.  
  1251.                 cCurrCmd := ""
  1252.  
  1253.             ENDIF
  1254.  
  1255.             DO CASE
  1256.  
  1257.                 CASE cBuffer == "{"
  1258.                     ++nGrpLevel
  1259.                     nGrpCmd := 0 // count # of commands found in group
  1260.  
  1261.                 CASE cBuffer == "}"
  1262.                     --nGrpLevel
  1263.                     nRealBytes := nRead // Mark spot where last group ended.
  1264.                     nGrpCmd := 0 // count # of commands found in group
  1265.  
  1266.                 CASE cBuffer == "\"
  1267.                     cCurrCmd += cBuffer
  1268.                     ++nGrpCmd
  1269.  
  1270.             ENDCASE
  1271.  
  1272.         ELSEIF !EMPTY( cCurrCmd )
  1273.  
  1274.             // We assume that anything other character is part of the command
  1275.             cCurrCmd += cBuffer
  1276.  
  1277.         ENDIF
  1278.  
  1279.     ENDDO
  1280.  
  1281.     // Now read the header bytes from the beginning.
  1282.     // Inefficient, but in the vast scheme of things, who really cares?
  1283.  
  1284.     cBuffer := ""
  1285.     IF nRealBytes > 0
  1286.         FSEEK( hFile, 0 )
  1287.         cBuffer := FREADSTR( hFile, nRealBytes )
  1288.     ENDIF
  1289.  
  1290.     FCLOSE( hFile )
  1291.  
  1292. ENDIF
  1293.  
  1294. RETURN cBuffer
  1295. ***********************  END OF RTFHeader()  ************************
  1296.  
  1297. FUNCTION IsRTF( cFile )
  1298. *********************************************************************
  1299. * Description:  Determine if a file is an RTF file
  1300. * Arguments:    
  1301. * Return:       
  1302. *               
  1303. *--------------------------------------------------------------------
  1304. * Date       Developer   Comments
  1305. * 02/05/97   TRM         Creation
  1306. *
  1307. *********************************************************************
  1308. LOCAL lRTF := .F., hFile, cBuffer := ""
  1309.  
  1310. hFile := FOPEN( cFile )
  1311. IF hFile >= 0
  1312.  
  1313.     FSEEK( hFile, 0 )
  1314.     cBuffer := FREADSTR( hFile, 5 )
  1315.  
  1316.     IF cBuffer == "{\rtf"
  1317.         lRTF := .T.
  1318.     ENDIF
  1319.     FCLOSE( hFile )
  1320.  
  1321. ENDIF
  1322.  
  1323. RETURN lRTF
  1324. ***********************  END OF IsRTF()  ************************
  1325.  
  1326. METHOD RichText:IntlTranslate()
  1327. *********************************************************************
  1328. * Description:  Example of an array that could be used to map
  1329. *               high-order characters.
  1330. * Arguments:    
  1331. * Return:       
  1332. *               
  1333. *--------------------------------------------------------------------
  1334. * Date           Developer       Comments
  1335. * 15 april 1998  Paul C. Laney   Creation
  1336. *
  1337. *********************************************************************
  1338. LOCAL aTranslate[128]
  1339.  
  1340. AFILL( aTranslate, chr(42) ) 
  1341. aTranslate[01] := "\'c7"
  1342. aTranslate[02] := "\'fc"
  1343. aTranslate[03] := "\'e9"
  1344. aTranslate[04] := "\'e2"
  1345. aTranslate[05] := "\'e4"
  1346. aTranslate[06] := "\'e0"
  1347. aTranslate[07] := "\'e5"
  1348. aTranslate[08] := "\'e7"
  1349. aTranslate[09] := "\'ea"
  1350. aTranslate[10] := "\'eb"
  1351. aTranslate[11] := "\'e8"
  1352. aTranslate[12] := "\'ef"
  1353. aTranslate[13] := "\'ee"
  1354. aTranslate[14] := "\'ec"
  1355. aTranslate[15] := "\'c4"
  1356. aTranslate[16] := "\'c5"
  1357. aTranslate[17] := "\'c9"
  1358. aTranslate[18] := "\'e6"
  1359. aTranslate[19] := "\'c6"
  1360. aTranslate[20] := "\'f4"
  1361. aTranslate[21] := "\'f6"
  1362. aTranslate[22] := "\'f2"
  1363. aTranslate[23] := "\'fb"
  1364. aTranslate[24] := "\'f9"
  1365. aTranslate[25] := "\'ff"
  1366. aTranslate[26] := "\'d6"
  1367. aTranslate[27] := "\'dc"
  1368. aTranslate[28] := "\'a2"
  1369. aTranslate[29] := "\'a3"
  1370. aTranslate[30] := "\'a5"
  1371. // aTranslate[31] := "Not Defined"
  1372. aTranslate[32] := "\'83"
  1373. aTranslate[33] := "\'e1"
  1374. aTranslate[34] := "\'ed"
  1375. aTranslate[35] := "\'f3"
  1376. aTranslate[36] := "\'fa"
  1377. aTranslate[37] := "\'f1"
  1378. aTranslate[38] := "\'d1"
  1379. aTranslate[39] := "\'aa"
  1380. aTranslate[40] := "\'ba"
  1381. aTranslate[41] := "\'bf"
  1382.  
  1383. ::aTranslate := aTranslate
  1384.  
  1385. RETURN Self
  1386. **********************  END OF IntlTranslate()  *********************
  1387.  
  1388.