Gracias
Code: Select all
CLASS RichText
DATA cFileName, hFile
DATA nFontSize
DATA nFontColor
DATA aTranslate
DATA nFontNum
DATA nScale
DATA lTrimSpaces
DATA nFontAct
DATA cLastApar INIT ""
DATA cLastBook INIT ""
// Table Management
DATA cTblHAlign, nTblFntNum, nTblFntSize, nTblRows, nTblColumns
DATA nTblRHgt, aTableCWid, cRowBorder, cCellBorder, aColPct, nCellPct
DATA lTblNoSplit, nTblHdRows, nTblHdHgt, nTblHdPct, nTblHdFont
DATA nTblHdFSize,nTblHdColor,nTblHdFColor
DATA cCellAppear, cHeadAppear
DATA cCellHAlign, cHeadHAlign
DATA nCurrRow, nCurrColumn
DATA TblCJoin
// textbox Variables
DATA txtbox,aSztBox,aCltBox,cTpltBox,nWltBox,nFPtbox
DATA aOfftbox
// Facing
DATA lFacing AS LOGICAL INIT .F.
//Styles Managament
DATA NStlDef INIT 1
DATA nStlAct INIT 0
DATA nCharStl INIT 1
DATA nCharAct INIT 0
DATA nStlSec INIT 1
DATA nSectAct INIT 0
DATA ParStyles AS ARRAY INIT {}
DATA CharStyles AS ARRAY INIT {}
DATA SectStyles AS ARRAY INIT {}
CLASSDATA lRegistered AS LOGICAL
// Methods for opening & closing output file, and setting defaults
METHOD New( cFileName, aFontData, nFontSize, nFontColor, nScale, aTrans ) CONSTRUCTOR
METHOD End() INLINE ::TextCode( "par\pard" ), ::CloseGroup(), FCLOSE(::hFile)
// Core methods for writing control codes & data to the output file
METHOD TextCode( cCode ) //INLINE FWRITE(::hFile, FormatCode(cCode) )
METHOD NumCode( cCode, nValue, lScale )
METHOD LogicCode( cCode, lTest )
METHOD Write( xData, lCodesOK )
// Groups and Sections (basic RTF structures)
METHOD OpenGroup() INLINE FWRITE( ::hFile, "{" )
METHOD CloseGroup() INLINE FWRITE( ::hFile, "}" )
METHOD NewSection( lLandscape, nColumns, nLeft, nRight, nTop, nBottom, ;
nWidth, nHeight, cVertAlign, lDefault )
// Higher-level page setup methods
METHOD PageSetup( nLeft, nRight, nTop, nBottom, nWidth, nHeight, ;
nTabWidth, lLandscape, cVertAlign, cPgNumPos, lPgNumTop, ;
lNoWidow )
METHOD BeginHeader() INLINE ::OpenGroup(), ;
IIF(!::lFacing,::TextCode("header \pard"),::TextCode("headerr \pard"))
METHOD EndHeader() INLINE ::TextCode("par"), ::CloseGroup()
METHOD BeginFooter() INLINE ::OpenGroup(), ;
IIF(!::lFacing,::TextCode("footer \pard"),::TextCode("footerr \pard"))
METHOD EndFooter() INLINE ::TextCode("par"), ::CloseGroup()
METHOD Paragraph( cText, nFontNumber, nFontSize, cAppear, ;
cHorzAlign, aTabPos, nIndent, nFIndent, nRIndent, nSpace, ;
lSpExact, nBefore, nAfter, lNoWidow, lBreak, ;
lBullet, cBulletChar, lHang, lDefault, lNoPar,;
nFontColor,cTypeBorder,cBordStyle,nBordCol,nShdPct,;
cShadPat,lChar,nStyle)
// Table Management
METHOD DefineTable( cTblHAlign, nTblFntNum, nTblFntSize, ;
cCellAppear, cCellHAlign, nTblRows, ;
nTblColumns, nTblRHgt, aTableCWid, cRowBorder, cCellBorder, aColPct, nCellPct, ;
lTblNoSplit, nTblHdRows, aHeadTit, nTblHdHgt, nTblHdPct, nTblHdFont, ;
nTblHdFSize, cHeadAppear, cHeadHAlign,nTblHdColor ,nTblHdFColor)
METHOD BeginRow() INLINE ::TextCode( "trowd" ), ::nCurrRow += 1
METHOD EndRow() INLINE ::TextCode( "row" )
METHOD WriteCell( cText, nFontNumber, nFontSize, cAppear, cHorzAlign, ;
nSpace, lSpExact, cCellBorder, nCellPct, nFontColor,lDefault )
// Methods for formatting data
METHOD Appearance( cAppear )
METHOD HAlignment( cAlign )
METHOD LineSpacing( nSpace, lSpExact )
METHOD Borders( cEntity, cBorder )
METHOD NewFont( nFontNumber )
METHOD SetFontSize( nFontSize )
METHOD SetFontColor( nFontColor )
METHOD NewLine() INLINE FWRITE(::hFile, CRLF), ::TextCode( "par")
METHOD NewPage() INLINE ::TextCode( "page" + CRLF )
// General service methods
METHOD BorderCode( cBorderID )
METHOD ShadeCode( cShadeID )
METHOD ParaBorder( cBorder,cType )
METHOD BegBookMark(texto)
METHOD EndBookMark()
// Someday maybe we'll handle:
// Styles
METHOD SetStlDef()
METHOD IncStyle( cName, styletype,nFontNumber,nFontSize,;
nFontColor,cAppear,cHorzAlign,nIndent,cKeys,;
cTypeBorder,cBordStyle,nBordColor,nShdPct,cShadPat,lAdd,lUpdate)
METHOD BeginStly()
METHOD WriteStly()
METHOD ParaStyle( nStyle )
METHOD CharStyle( nStyle )
// Alternating shading of table rows
// Footnotes & Endnotes
METHOD FootNote(cTexto,cChar,nFontNumber,nFontSize,cAppear,nFontColor,lEnd,lAuto,lUpper)
// Shaded text
// Frames
// Text Boxes
METHOD BegTextBox(cTexto,aOffset, aSize, cTipo, aColores,nWidth,nPatron,;
lSombra,aSombra,nFontNumber,nFontSize,cAppear,nFontColor,lRounded,lEnd)
METHOD EndTextBox()
// Font Colors
METHOD SetClrTab()
// Lines, Bitmaps & Graphics
METHOD Linea(aInicio,aFinal,nxoffset,nyoffset,aSize,cTipo, ;
nColBlue, nColRed,nColGreen,nWidth,nPatron,lSombra,aSombra)
METHOD IncImage(cName,aSize,cHorzAlign,lFrame)
// Information
METHOD InfoDoc( cTitle, cSubject,cAuthor, cManager, cCompany, cOperator, ;
cCategor,cKeyWords,cComment )
METHOD DocFormat(nTab,nLineStart,lBackup,nDefLang,nDocType,;
cFootType,cFootNotes,cEndNotes,cFootNumber,nPage,cProtect,lFacing,nGutter)
// Lots of other cool stuff
// New Methods for table managament
METHOD EndTable() INLINE ::CloseGroup()
METHOD TableDef(lHeader,nRowHead,cCellBorder,aCellPct)
METHOD TableCell( cText, nFontNumber, nFontSize, cAppear, cHorzAlign, ;
nSpace, lSpExact, cCellBorder, nCellPct, nFontColor,;
lDefault,lHeader )
METHOD CellFormat(cCellBorder,aCellPct)
METHOD DefNewTable( cTblHAlign, nTblFntNum, nTblFntSize, ;
cCellAppear, cCellHAlign, nTblRows, ;
nTblColumns, nTblRHgt, aTableCWid, cRowBorder, cCellBorder, aColPct, nCellPct, ;
lTblNoSplit, nTblHdRows, aHeadTit, nTblHdHgt, nTblHdPct, nTblHdFont, ;
nTblHdFSize, cHeadAppear, cHeadHAlign,nTblHdColor ,nTblHdFColor,aTblCJoin )
ENDCLASS
METHOD New( cFileName, aFontData, aFontFam,aFontChar,nFontSize, nFontColor,nScale, aHigh ) CLASS RichText
*********************************************************************
* Description: Initialize a new RTF object, and create an associated
* file, with a valid RTF header.
*
* Arguments:
*
* Return:
*
*--------------------------------------------------------------------
* Date Developer Comments
* 01/06/97 TRM Creation
*
*********************************************************************
LOCAL i
LOCAL cTopFile := "rtf1\ansi\ansicpg1252\deff0"
LOCAL cColors := ::SetClrTab()
DEFAULT ;
cFileName := "REPORT.RTF", ;
aFontData := { "Courier New" }, ;
nFontSize := 12,;
nScale := INCH_TO_TWIP,;
nFontColor:= 0
::cFileName := cFileName
::nFontSize := nFontSize
::nScale := nScale
::nFontColor:= nFontColor
::lTrimSpaces := .F.
IF aFontFam==nil
aFontFam:=ARRAY(aFontData)
AFILL(aFontFam,"fnil")
ENDIF
IF aFontChar==nil
aFontChar:=ARRAY(aFontData)
AFILL(aFontChar,0)
ENDIF
IF VALTYPE(aHigh) == "A"
::aTranslate := aHigh
ENDIF
// If no extension specified in file name, use ".RTF"
IF !("." $ ::cFileName)
::cFileName += ".RTF"
ENDIF
// Create/open a file for writing
::hFile := FCREATE(::cFileName)
IF ::hFile >= 0
// Generate RTF file header
// This opens the top-most level group for the report
// This group must be explicitly closed by the application!
::OpenGroup()
::TextCode( cTopFile )
// Generate a font table, and write it to the header
::nFontNum := LEN(aFontData)
::OpenGroup()
::TextCode( "fonttbl" )
FOR i := 1 TO ::nFontNum
::OpenGroup()
::NewFont( i )
::NumCode( "charset",aFontChar[i],.F. )
::TextCode( aFontFam[i] )
::Write( aFontData[i] + "" ) //aquí iba un ";"
::CloseGroup()
NEXT
::CloseGroup()
// Use default color info, for now...
::OpenGroup()
::TextCode( cColors )
::CloseGroup()
// NOTE: At this point, we have an open group (the report itself)
// that must be closed at the end of the report.
ENDIF
RETURN NIL
************************** END OF New() ***************************