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 / demrtf.prg < prev    next >
Text File  |  1999-08-19  |  15KB  |  500 lines
  1. #include "richtext.ch"
  2. #define CRLF chr(13)+chr(10)
  3.  
  4. *--------------------------------------------------------------------
  5.   FUNCTION DemRtf()
  6. *--------------------------------------------------------------------
  7. LOCAL cOutFile := cDataPath + "RTFDEMO.RTF"
  8. LOCAL lErrflag := .F.
  9. LOCAL cThread := tdStrnum(threadObject():threadId)
  10.  
  11.    ******* log in
  12.    tdLog('Entered RichText Demo - Thread ' + cThread)
  13.  
  14.    ********************* Open files
  15.    DO WHILE .T.   // control loop
  16.  
  17.       ******* veggies en flowers
  18.       IF ! tdOpenDbf('veggies.dbf','veggies','shared') .OR. ;
  19.             ! tdOpenDbf('flowers.dbf','flowers','shared')
  20.          lErrflag := .T.
  21.          EXIT
  22.       ELSE
  23.          veggies->( dbGoTop() )
  24.          flowers->( dbGoTop() )
  25.       ENDIF
  26.       EXIT
  27.  
  28.    ENDDO
  29.  
  30.    ******* Test for any file open errors
  31.    IF lErrflag
  32.       CLOSE DATABASES
  33.       RETURN .F.
  34.       TdMsg( "Files FLOWERS.DBF & DBT and VEGGIES.DBF are required for demo." )
  35.    ENDIF
  36.  
  37.    ********************* End Open files
  38.  
  39.    // Start the demo
  40.    GardenDoc( cOutFile )
  41.  
  42. //    MsgMeter( bMeter, "Generating sample reports...", "RichText() Demo" )
  43.  
  44. //    MsgInfo( "Formatting complete.  To see the output, open files " + ;
  45. //            cOutFile + " and MERGEOUT.RTF in a word processor " + ;
  46. //            "[NOTE: System was tested with Microsoft Word]." )
  47.  
  48. //    MsgInfo( "To see the Table of Contents in MS-Word, refer to the " + ;
  49. //            "MS-Word documentation.  Be sure to tell MS-Word to generate " + ;
  50. //            'the table from "table entries", rather than from "styles".' )
  51.  
  52. veggies->( dbCloseArea() )
  53. flowers->( dbCloseArea() )
  54.  
  55. TdMsg( " done" ) 
  56.   
  57. RETURN ( NIL )
  58.  
  59.  
  60. STATIC FUNCTION GardenDoc( cOutFile)
  61. *********************************************************************
  62. * Description:  Demo of selected features of RichText() Class
  63. * Arguments:    
  64. * Return:       
  65. *               
  66. *--------------------------------------------------------------------
  67. * Date       Developer   Comments
  68. * 01/28/97   TRM         Creation
  69. * 02/03/97   TRM         Added ::Merge() demo
  70. *********************************************************************
  71. LOCAL oRTF, n := 0
  72.  
  73.    // Open the output file & set some defaults
  74.  
  75.    oRTF := SetupRTF( cOutFile )
  76.  
  77.  
  78.    IF oRTF:hFile >= 0  // avoid a crash if the file was already open.
  79.  
  80.       // Demonstrate basics -- fonts, text appearance, hanging indents, etc.
  81.  
  82.       CoverPage( oRTF )
  83.  
  84.       // Demonstrate a simple DBF output
  85.  
  86.       veggies->( DbfToRTF( oRtf, .F. ) )
  87.  
  88.       // Demonstrate mixed orientation (i.e, change to landscape)
  89.       // and a DBF with memos.
  90.  
  91.       flowers->( DbfToRtf( oRTF, .T. ) )
  92.  
  93.       // Demonstrate same memo text formatted in snaked columns
  94.       // in portrait orientation
  95.  
  96.       flowers->( dbGoTop() )
  97.       flowers->( FlowerColumns( oRTF ) )
  98.  
  99.       // Demonstrate ::Merge() capability
  100.       veggies->( dbGoTop() )
  101.       veggies->( MergeDemo() )
  102.  
  103.       // Close the output file
  104.       CLOSE RTF oRTF
  105.  
  106.    ENDIF
  107.  
  108. RETURN NIL
  109. **********************  END OF GardenDoc()  **********************
  110.  
  111. STATIC FUNCTION SetupRTF( cOutFile)
  112. *********************************************************************
  113. * Description:  
  114. * Arguments:    
  115. * Return:       
  116. *               
  117. *--------------------------------------------------------------------
  118. * Date       Developer   Comments
  119. * 01/28/97   TRM         Creation
  120. *
  121. *********************************************************************
  122. LOCAL oRTF
  123.  
  124.    DEFINE RTF oRTF FILE cOutFile ;
  125.       FONTS "Times New Roman", "Arial", "Courier New" ;
  126.       FONTSIZE 12 ;
  127.       TWIPFACTOR 1440 ;
  128.       WARNOVERWRITE ; // Warn if output file already exists
  129.       GETFILENAME FORCEPATH ""
  130.  
  131.    IF oRTF:hFile >= 0
  132.  
  133.       // Trim trailing spaces from data, to save file space.
  134.       oRTF:lTrimSpaces := .T.
  135.  
  136.       DEFINE PAGESETUP oRTF MARGINS 1.75, 1.75, 1, 1 ;
  137.          TABWIDTH .5 ;
  138.          ALIGN CENTER
  139.  
  140.          BEGIN HEADER oRTF
  141.             NEW PARAGRAPH oRTF TEXT "RichText() Sample Report " + ;
  142.                DTOC(DATE()) + " " + time() ;
  143.             FONTSIZE 14 ;
  144.             ALIGN CENTER
  145.          END HEADER oRTF
  146.  
  147.          BEGIN FOOTER oRTF
  148.  
  149.             NEW PARAGRAPH oRTF TEXT "" ALIGN CENTER
  150.  
  151.             INSERT PAGENUMBER oRTF
  152.  
  153.          END FOOTER oRTF
  154.  
  155.    ENDIF
  156.  
  157. RETURN oRTF
  158. **********************  END OF SetupRTF()  ***********************
  159.  
  160. STATIC FUNCTION CoverPage( oRTF )
  161. *********************************************************************
  162. * Description:  Generate a cover page.
  163. * Arguments:    
  164. * Return:       
  165. *               
  166. *--------------------------------------------------------------------
  167. * Date       Developer   Comments
  168. * 01/28/97   TRM         Creation
  169. *
  170. *********************************************************************
  171. LOCAL i
  172. LOCAL aTitle[3]
  173. LOCAL aBullet[6]
  174.  
  175.    // First, load some text...
  176.  
  177.    aTitle[1] := "RichText() Sample Report Summary"
  178.  
  179.    aTitle[2] := "NOTE: This report includes an automated table of " + ;
  180.                 "contents. If you are using MS-Word, you can create " + ;
  181.                 "the table of contents via the Insert\Indexes and " + ;
  182.                 "Tables... option. Be sure to tell 'MS-Word' to " + ;
  183.                 "generate the table from 'table entries', rather " + ;
  184.         "than from 'styles'."
  185.  
  186. aBullet[1] := "This report is a demonstration of some of the capabilities " + ;
  187.             "of the RichText() class Xbase++, Version 1.0, rewritten " + ;
  188.                         "by Paul C. Laney, and based " + ;
  189.                         "on the Clipper & Fivewin version written " + ;
  190.             "by Tom Marchione.  This is the free version, which contains a " + ;
  191.             "basic feature set (please review the README file for certain " + ;
  192.             "minor usage restrictions). If you have any comments or questions, " + ;
  193.             "feel free to send an E-Mail to pclaney@compuserve.com."
  194.  
  195. aBullet[2] := "RichText() lets you generate reports to RTF files, like this " + ;
  196.             "one.  RTF files can be read by most word processors, so this " + ;
  197.             "is a way to move fully-formatted information into word processor " + ;
  198.             "format, without lots of extra spaces and carriage returns.  " + ;
  199.             "The class can form the basis of a true database publishing system."
  200.  
  201. aBullet[3] := "RichText() is not meant to be a front-line report engine in " + ;
  202.             "its current form, in the sense that database programmers " + ;
  203.             "expect report generators to have certain standard features.  " + ;
  204.             "Nevertheless, it can be very useful for meeting specialized, " + ;
  205.             "custom reporting requirements, particularly if you need to edit or " + ;
  206.             "manipulate the output."
  207.  
  208. aBullet[4] := "In its current form, the system is fairly quirky.  " + ;
  209.             "The good news is that, generally, you can get exactly what you " + ;
  210.             "want in one or two code iterations.  I plan to address " + ;
  211.             "various usability issues in future versions."
  212.  
  213. aBullet[5] := "The pages that follow contain some examples of the types of " + ;
  214.             "things that can be done with RichText().  Remember, RichText() " + ;
  215.             "is designed to link to a word processor, so its capabilities " + ;
  216.             "focus on standard word processing features, rather than the " + ;
  217.             "kinds of things that are important in a standard report " + ;
  218.             "generator.  Hope you find it useful!"
  219.  
  220. aBullet[6] := "Also Highbit characters are supported like " + chr(137) + " =chr(137), " + ;
  221.                chr(138) + " =chr(138), " + chr(139) + " =chr(139), " + chr(140) + ;
  222.                " =chr(140), " + chr(141) + " =chr(141)"
  223.  
  224. // Write the title lines
  225.  
  226. NEW PARAGRAPH oRTF TEXT aTitle[1] ;
  227.     FONTNUMBER 1 ;
  228.     FONTSIZE 18 ;
  229.     APPEARANCE BOLD_ON ;
  230.     ALIGN CENTER ;
  231.     SETDEFAULT ;
  232.     TOCLEVEL 1  // 10/24/97 -- mark this for the Table of Contents.
  233.  
  234. NEW PARAGRAPH oRTF TEXT ""
  235.  
  236. NEW PARAGRAPH oRTF TEXT aTitle[2] ;
  237.     FONTSIZE 10 ;
  238.     APPEARANCE BOLD_OFF + ITALIC_ON ;
  239.     ALIGN LEFT ;
  240.     INDENT -.5 ;
  241.     RIGHTINDENT -.5
  242.  
  243. NEW PARAGRAPH oRTF TEXT "" ;
  244.     APPEARANCE BOLD_OFF + ITALIC_OFF ;
  245.     SETDEFAULT
  246.  
  247.  
  248. // Write the bullet items
  249.  
  250. FOR i := 1 TO LEN( aBullet )
  251.  
  252.     NEW PARAGRAPH oRTF TEXT aBullet[i] ;
  253.         FONTNUMBER 2 ;
  254.         FONTSIZE 11 ;
  255.         ALIGN LEFT ;
  256.         INDENT .25 ;
  257.         FIRSTINDENT -.25 ;
  258.         BULLETED ;
  259.         SPACEBEFORE .4 ;
  260.         SETDEFAULT
  261.  
  262. NEXT
  263.  
  264. NEW PARAGRAPH oRTF TEXT "" SETDEFAULT
  265.  
  266. RETURN NIL
  267. ************************  END OF CoverPage()  ***********************
  268.  
  269. STATIC FUNCTION DBFToRTF( oRTF, lLandScape, cTitle )
  270. *********************************************************************
  271. * Description:  Format specified DBF into an RTF Table
  272. * Arguments:    
  273. * Return:       
  274. *               
  275. *--------------------------------------------------------------------
  276. * Date       Developer   Comments
  277. * 01/28/97   TRM         Creation
  278. *
  279. *********************************************************************
  280. LOCAL i, nWidth, aStruc
  281. LOCAL aFldNames := {}, aColWidth := {}
  282. LOCAL nTotWidth := 0, cName
  283.  
  284. aStruc := DBSTRUCT()
  285.  
  286. FOR i := 1 TO LEN( aStruc )
  287.  
  288.     IF LEFT(aStruc[i][2], 1) == "M"
  289.         // Default memo Columns to 4 inches wide
  290.         nWidth := 4
  291.     ELSE
  292.         // Default non-memo columns to 1/10th of field width
  293.         nWidth := (aStruc[i][3] + aStruc[i][4])/10
  294.  
  295.         // Stretch column width to width of header, if necessary
  296.         nWidth := MAX( nWidth, LEN(ALLTRIM(aStruc[i][1]))/9 )
  297.         
  298.         // Place a limit of 5 inches on the width of any single column
  299.         nWidth := MIN( nWidth, 5 )
  300.     ENDIF
  301.  
  302.     nTotWidth += nWidth
  303.     IF nTotWidth <= 10
  304.         AADD( aFldNames, ALLTRIM( aStruc[i][1] ) )
  305.         AADD( aColWidth, nWidth )
  306.     ELSE
  307.         EXIT // For demo, only include enough columns as will fit
  308.     ENDIF
  309.     
  310. NEXT
  311. aStruc := NIL
  312.  
  313.  
  314. // Begin a new section of the document
  315.  
  316. IF lLandScape
  317.     NEW SECTION oRTF ;
  318.         LANDSCAPE ;
  319.         PAGEWIDTH 11 ;
  320.         PAGEHEIGHT 8.5 ;
  321.         MARGINS .5, .5, .5, .5 ;
  322.         ALIGN CENTER ;
  323.         SETDEFAULT
  324. ELSE
  325.     NEW SECTION oRTF ;
  326.         PAGEWIDTH 8.5 ;
  327.         PAGEHEIGHT 11 ;
  328.         MARGINS .5, .5, .5, .5 ;
  329.         ALIGN CENTER ;
  330.         SETDEFAULT
  331. ENDIF
  332.  
  333.  
  334. // Add a title, for use in the table of contents
  335.  
  336. IF EMPTY( cTitle )
  337.     cTitle := "Sample Table Derived From " + Alias() + ".dbf"
  338. ENDIF
  339.  
  340. NEW PARAGRAPH oRTF TEXT cTitle ;
  341.     FONTNUMBER 1 ;
  342.     FONTSIZE 18 ;
  343.     APPEARANCE BOLD_ON ;
  344.     ALIGN CENTER ;
  345.     SETDEFAULT ;
  346.     TOCLEVEL 1
  347.  
  348. NEW PARAGRAPH oRTF TEXT ""
  349. NEW PARAGRAPH oRTF TEXT ""
  350.  
  351. // Define the table
  352.  
  353. DEFINE TABLE oRTF ;              // Specify the RTF object
  354.     ALIGN CENTER ;                // Center table horizontally on page
  355.     FONTNUMBER 2 ;                // Use font #2 for the body rows
  356.     FONTSIZE 9 ;                  // Use 9 Pt. font for the body rows
  357.     CELLAPPEAR BOLD_OFF ;         // Normal cells unbolded
  358.     CELLHALIGN LEFT ;             // Text in normal cells aligned left
  359.     COLUMNS LEN(aFldNames) ;      // Table has n Columns
  360.     CELLWIDTHS aColWidth ;        // Array of column widths
  361.     ROWHEIGHT .25 ;               // Minimum row height is .25"
  362.     CELLBORDERS SINGLE ;          // Outline cells with thin border
  363.     HEADERROWS 1 ;                // One row to be treated as the header
  364.         HEADERHEIGHT .5 ;          // Header rows are min. .5" high
  365.         HEADERSHADE 25 ;           // Header shading is 25%
  366.         HEADERFONT 1 ;             // Use font #1 for the header
  367.         HEADERFONTSIZE 10 ;        // Use 10 Pt. font for the header
  368.         HEADERAPPEAR BOLD_ON ;     // Header cells are bold
  369.         HEADERHALIGN CENTER        // Text in header cells is centered
  370.  
  371. // Write the header row, using field names as titles
  372. FOR i := 1 TO oRTF:nTblColumns
  373.  
  374.     // Abbreviate column headers that are disproportionately long
  375.     cName := aFldNames[i]
  376.     IF LEN( cName ) > aColWidth[i]
  377.         cName := LEFT( cName, aColWidth[i]-1 ) + "."
  378.     ENDIF
  379.     WRITE CELL oRTF TEXT aFldNames[i]
  380.  
  381. NEXT
  382.  
  383. // Write the data rows
  384. DO WHILE !EOF()
  385.     FOR i := 1 TO oRTF:nTblColumns
  386.            WRITE CELL oRTF TEXT FIELDGET(i)
  387.     NEXT
  388.     DBSKIP()
  389. ENDDO
  390.  
  391. // Close the table
  392. CLOSE TABLE oRTF
  393.  
  394. RETURN NIL
  395. ***********************  END OF DBFToRTF()  *********************
  396.  
  397. STATIC FUNCTION FlowerColumns( oRTF )
  398. *********************************************************************
  399. * Description:  Format FLOWERS.DBF memo data as prose in snaking
  400. *               columns.
  401. * Arguments:    
  402. * Return:       
  403. *               
  404. *--------------------------------------------------------------------
  405. * Date       Developer   Comments
  406. * 01/28/97   TRM         Creation
  407. *
  408. *********************************************************************
  409. LOCAL cText, i := 0
  410.  
  411. oRTF:lTrimSpaces := .F.
  412.  
  413. // Begin a new section of the document, in order
  414. // to switch page orientation back to portrait.
  415.  
  416. NEW SECTION oRTF ;
  417.     COLUMNS 2 ;
  418.     PAGEWIDTH 8.5 ;
  419.     PAGEHEIGHT 11 ;
  420.     MARGINS .75, .75, 1, 1 ;
  421.     ALIGN TOP ;
  422.     SETDEFAULT
  423.  
  424. DO WHILE !EOF()
  425.  
  426.     ++i
  427.     IF i > 1
  428.         NEW PARAGRAPH oRTF TEXT ""
  429.     ENDIF
  430.  
  431.     NEW PARAGRAPH oRTF TEXT RTRIM( (Alias())->Name) + ".  " ;
  432.         FONTNUMBER 1 ;
  433.         FONTSIZE 14 ;
  434.         APPEARANCE BOLD_ON + ITALIC_ON ;
  435.         ALIGN JUSTIFY ;
  436.         SPACEBEFORE IIF( i == 1, 0, .4 ) ;
  437.         SETDEFAULT ;
  438.         TOCLEVEL 2 ;
  439.         NORETURN
  440.  
  441.     cText := ( Alias() )->Descriptio
  442.  
  443.     NEW PARAGRAPH oRTF TEXT cText ;
  444.         APPEARANCE BOLD_OFF + ITALIC_OFF ;
  445.         NORETURN
  446.  
  447.     DBSKIP()
  448.  
  449. ENDDO
  450.  
  451. RETURN NIL
  452. ***********************  END OF FlowerColumns()  *********************
  453.  
  454. FUNCTION MergeDemo()
  455. *********************************************************************
  456. * Description:  Demonstrate capabilities of RTFMerge() function
  457. * Arguments:    
  458. * Return:       
  459. *               
  460. *--------------------------------------------------------------------
  461. * Date       Developer   Comments
  462. * 02/03/97   TRM         Creation
  463. * 02/05/97   TRM         It finally does something...
  464. *
  465. *********************************************************************
  466. LOCAL cInFile := cDataPath + "MERGEIN.RTF"
  467. LOCAL cOutFile := cDataPath + "MERGEOUT.RTF"
  468. LOCAL hOutFile
  469. LOCAL cHeader, nLenHead
  470.  
  471. // Identify the header length of the primary merge file,
  472. // because we need to handle the header separately
  473. cHeader := RTFHeader( cInFile )
  474. nLenHead := LEN( cHeader )
  475.  
  476. // First create the output file and transfer the header to it.
  477. hOutFile := FCREATE(cOutFile)
  478. FWRITE( hOutFile, cHeader )
  479.  
  480. // Now merge away!
  481. // (only process 3 records for demo purposes)
  482. DO WHILE RECNO() < 4
  483.  
  484.     RTFMerge( cInFile, nLenHead, hOutFile )
  485.  
  486.     // Write a hard page break to the file
  487.     FWRITE( hOutFile, "\par\page" + CRLF )
  488.  
  489.     DBSKIP()
  490.  
  491. ENDDO
  492.  
  493. FWRITE( hOutFile, "}" )
  494. FCLOSE( cOutFile )
  495.  
  496. RETURN NIL
  497. *********************** END OF MergeDemo()  *************************
  498.  
  499.  
  500.