FiveTech Support Forums

FiveWin / Harbour / xBase community
Board indexAll discussionsLogin (GitHub)
Board index FiveWin para Harbour/xHarbour 驴C贸mo enviar a Excel reporte con TPrinter?
FranciscoA
Posts: 2170
Joined: Fri Jul 18, 2008 01:24 AM
驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Thu Feb 05, 2009 02:57 PM

Hola amigos del foro. Es eso. Utilizo mucho la clase TPrinter para mis reportes y necesito enviarlos a Excel.
驴Alguno de ustedes puede orientarme, o falicilitarme un peque帽o ejemplo?
Gracias.

Francisco J. Alegr铆a P.

Chinandega, Nicaragua.



Fwxh-MySql-TMySql
Ramon Paredes
Posts: 215
Joined: Fri Feb 02, 2007 03:38 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Thu Feb 05, 2009 10:49 PM

Francisco,

Por que no utilizas Filexls puedes usarla con coordenadas y operaciones matematicas y rompimientos de control y todo lo demas

Saludes

Ramon Paredes

... Desde la Tierra de lagos y Volcanes......
Ramon Paredes
Posts: 215
Joined: Fri Feb 02, 2007 03:38 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Thu Feb 05, 2009 10:53 PM

Francisco:

Un peque帽o ejemplo del uso de filexls

SELECT A
USE RGEN1

PUBLIC oFileXLS,oDlg, oLbx, oFont, oMeter, nMeter,oExcel, oHoja, oBrw

DEFINE FONT oFont NAME "Arial" SIZE 0,-11

PUBLIC lIni := .t., nReg := RecNo(), cActividad := ""

PUBLIC nFormat1, nFormat2,nContar,nContar1
PUBLIC nFont1, nFont2, nFont3, nFont4
nContar = 0
nContar1 = 0

PUBLIC aRowActividad := {}

PUBLIC cSuma1 := "", cSuma2 := "" ,cSuma3 := "", cSuma4 := "",cSuma5 := ""
PUBLIC cSuma6 := "", cSuma7 := "" ,cSuma8 := "", cSuma9 := "",cSuma10 := ""
PUBLIC cSuma11 := "", cSuma12 := "" ,cSuma13 := "", cSuma14 := "",cSuma15 := ""
PUBLIC cSuma16 := ""

PUBLIC nRow, nRowActividad

oExcel := TOleAuto():New( "Excel.Application" )
oHoja := oExcel:Get( "ActiveSheet" )

DEFINE XLS FORMAT nFormat1 PICTURE '#,##0' // para pesetas
DEFINE XLS FORMAT nFormat2 PICTURE '#,##0.00' // para euros

DEFINE XLS FONT nFont1 NAME "Arial" HEIGHT 14 ITALIC BOLD
DEFINE XLS FONT nFont2 NAME "Arial" UNDERLINE
DEFINE XLS FONT nFont3 NAME "Arial Unicode MS" HEIGHT 9
DEFINE XLS FONT nFont4 NAME "Arial Unicode MS" HEIGHT 8

XLS oFileXLS FILE "MAESTRO1.XLS" //AUTOEXEC

XLS COL 1 WIDTH 7 OF oFileXLS
XLS COL 2 WIDTH 25 OF oFileXLS
XLS COL 3 WIDTH 15 OF oFileXLS
XLS COL 4 WIDTH 12 OF oFileXls
XLS COL 5 WIDTH 12 OF oFileXls
XLS COL 6 WIDTH 15 OF oFileXls

nRow := 2
@ nRow,1 XLS SAY "EMPRESA DE SERVICIOS MULTIPLES " FONT nfont1 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "REPORTE GENERAL DE EMPLEADOS ACTIVOS" FONT nfont2 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "CLASIFICADO POR : "+ALLTRIM(xOrden) FONT nfont2 OF oFileXLS
nRow++
@ nRow,1 XLS SAY "Numero" FONT nfont2 OF oFileXLS
@ nRow,2 XLS SAY "Nombres " FONT nfont2 OF oFileXLS
@ nRow,3 XLS SAY "Apellido1" FONT nfont2 OF oFileXLS
@ nRow,4 XLS SAY "Apellido2" FONT nfont2 OF oFileXLS
@ nRow,5 XLS SAY "Fec_Ing" FONT nfont2 OF oFileXLS
@ nRow,6 XLS SAY "Inss" FONT nfont2 OF oFileXLS
nRow += 2
GO TOP
DO WHILE .NOT.EOF()
mUnidad = A->COD_UNI
nRow++
@ nRow,1 XLS SAY "UNIDAD ADMINISTRATIVA : "+A->COD_UNI+"-"+A->NOM_UNI FONT nfont2 OF oFileXLS
nRow++
store 0 to nContar1
DO WHILE mUnidad = A->COD_UNI
nRow++
@ nRow,1 xls say TRIM( A->NUMERO ) FONT nFont4 of oFilexls
@ nRow,2 XLS SAY TRIM( A->NOMBRES) FONT nFont4 of oFilexls
@ nRow,3 XLS SAY TRIM( A->APELLI1) FONT nFont4 of oFilexls
@ nRow,4 XLS SAY TRIM( A->APELLI2) FONT nFont4 of oFilexls
@ nRow,5 XLS SAY TRIM( DTOC(A->FEC_ING)) FONT nFont4 of oFilexls
@ nRow,6 XLS SAY TRIM( A->INSSBI) FONT nFont4 of oFilexls

     nContar  = nContar  + 1
     nContar1 = nContar1 + 1

     SKIP
  ENDDO
  nRow++
  nRow++
  @ nRow,2 XLS SAY "Empleados x Unidad  : "+STR(nContar1) FONT nfont3 OF oFileXLS

ENDDO
nRow++
nRow++
@ nRow,1 XLS SAY "Empleados " +STR(nContar) FONT nFont3 OF oFileXLS
nRow++
nRow++

XLS PAGE BREAK AT nRow OF oFileXLS

SET XLS TO DISPLAY ;
NOGRIDLINES ;
OF oFileXLS

SET XLS TO PRINTER ;
TOP MARGIN 0.6 ;
BOTTOM MARGIN 0.8 ;
LEFT MARGIN 0 ;
OF oFileXLS

ENDXLS oFileXLS

oExcel:Visible := .T.
oExcel:WorkBooks:Open(cFilePath(GetModuleFileName(GetInstance()))+"MAESTRO1.XLS")

CLOSE RGEN1

// oHoja:End()
// oExcel:End()

RETURN NIL

... Desde la Tierra de lagos y Volcanes......
FranciscoA
Posts: 2170
Joined: Fri Jul 18, 2008 01:24 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Fri Feb 06, 2009 02:56 AM

Ram贸n, muchas gracias por responder. En verdad, no se me ha dado por usar filexls, directamente, aunque he leido bastante sobre el particular, en este foro. Actualmente utilizo RepExcel, que funciona satisfactoriamente pero solo con TReport. La idea que tengo es que desde el preview, con TPrinter, enviar el reporte a Excel. Es decir, mantener la opcion est谩ndar de impresi贸n con TPrinter-Preview, y poder elegir desde 茅ste, su exportaci贸n a Excel.
Agradezco el ejemplo que me facilitas, lo pruebo y luego te cuento.

Saludos.

Francisco J. Alegr铆a P.

Chinandega, Nicaragua.



Fwxh-MySql-TMySql
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Fri Feb 06, 2009 05:58 AM

Querido Ramon Paredes,

Es la clase FileXLS OLE depende?. Estoy buscando una clase que puede crear archivos de Excel, incluso si msexcel no est谩 instalado en el PC.

Parece que podemos hacer todo el formato de las columnas como el color, bold, Italics, etc
驴Puedo tener una copia de la clase FileXLS.

Gracias de antemano

Recuerdos

Anser

Ramon Paredes
Posts: 215
Joined: Fri Feb 02, 2007 03:38 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 02:40 AM

Mi estimado anserkk

Puedes bajar este archivo zip filexls.rar, en el van 3 prg 2 que son complementos de la clase y 1 la clase misma, unicamente tienes que agregarlos en tu proyecto como un prg mas y listo ya puedes usar toda la potencia de esta clase maravillosa, si necesitas ayuda o ejemplos me avisas que estamos para ayudarnos,

El link es :

http://www.megaupload.com/es/?d=2ATXPGVJ

Saludes

Ramon Paredes

... Desde la Tierra de lagos y Volcanes......
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 04:59 AM

Estimado Ram贸n Paredes,

Muchas gracias por el enlace de descarga.

El zip contiene 3 PRG del saber

TFileXLS.Prg
XLSError.Prg
XLSFunc.Prg

Por lo que tengo que a帽adir todas estas 3 del prg a mi proyecto para la CLASS para funcionar correctamente. 驴Tengo raz贸n?

驴Perdiste todo. CH archivos. Cuando he le铆do el c贸digo de ejemplo que envi贸 por encima en este hilo parece que hay una. CH archivo

XLS oFileXLS FILE "MAESTRO1.XLS" / / AUTOEXEC

驴Puede mostrarme una muestra PRG en Oop Sintaxis para, por ejemplo:
oXls: = TFileXls ():New("C:\Prueba.xls")

Una de las principales ventajas es que, esta CLASS no utiliza OLE, Para que MS-Excel no necesita ser instalado en el PC de la CLASS a la obra. Una vez que el archivo. Xls es creado usando esta clase, que se puede abrir a trav茅s de OpenOffice Calc.

Una vez m谩s gracias en gran medida de la CLASS

驴Me puede dar una muestra PRG mostrar el uso y la mayor铆a de las funcionalidades de esta excelente clase.

Saludos

Anser

Antonio Linares
Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 08:08 AM
Copio aqui el contenido de los ficheros para que no se pierdan :-)

TFileXLS.prg
Code: Select all Collapse
// FileXLS Library by Ram贸n Avenda帽o
// 30-12-99

#include "FiveWin.ch"
#include "Constant.ch"
//#include "XLSError.ch"
#include "FileIO.ch"

//#define _MSLINK_

static nInfo, cInfo := "FileXLS Library" + CRLF + ;
                       "Ram贸n Avenda帽o (c) 1999"

// Cell alignament
#define ALING_NULL       0
#define ALING_LEFT       1
#define ALING_CENTER     2
#define ALING_RIGHT      3
#define ALING_FILL       4

// Cell border
#define BORDER_NONE      0
#define BORDER_LEFT      8
#define BORDER_RIGHT    16
#define BORDER_TOP      32
#define BORDER_BOTTOM   64
#define BORDER_ALL     120  // nOR( BORDER_LEFT, BORDER_RIGHT, BORDER_TOP, BORDER_BOTTOM )

// XLS font def
#define XLSFONT_HEIGHT     1
#define XLSFONT_BOLD       2
#define XLSFONT_ITALIC     3
#define XLSFONT_UNDERLINE  4
#define XLSFONT_STRIKEOUT  5
#define XLSFONT_NAME       6

// XLS error code
#define XLSERROR_NULL      0
#define XLSERROR_DIV0      7
#define XLSERROR_VALUE    15
#define XLSERROR_REF      23
#define XLSERROR_NAME     29
#define XLSERROR_NUM      36
#define XLSERROR_N_A      42

EXTERNAL _XLSGenError

#ifdef _MSLINK_
EXTERNAL xlsCELL, xlsSUM, xlsMULT
EXTERNAL xlsABS, xlsINTE, xlsMOD, xlsROUND, xlsSIGN, xlsSQRT, xlsEXP, xlsLN, xlsLOG, ;
         xlsPI, xlsRANDOM, xlsSIN, xlsCOS, xlsTAN, xlsASIN, xlsACOS, xlsATAN
#else
EXTERNAL _CELL, _SUM, _MULT
EXTERNAL _ABS, _INTE, _MOD, _ROUND, _SIGN, _SQRT, _EXP, _LN, _LOG, ;
         _PI, _RANDOM, _SIN, _COS, _TAN, _ASIN, _ACOS, _ATAN
#endif

static aFonts := {}, aFormats := {}

static aOperators := { "", "", "+", "-", "*", "/", "^" }

//----------------------------------------------------------------------------//

CLASS TFileXLS

   DATA   cName
   DATA   hFile

   DATA   oWnd

   DATA   lProtect
   DATA   lAutoexec

   DATA   aHBreaks, aVBreaks

   METHOD New( cFileName, lAutomatic, nIterations,;
               lProtect, lAutoexec, oWnd ) CONSTRUCTOR

   METHOD End()

   //

   METHOD SetDisplay( nTop, nLeft, nBottom, nRight, lHidden, ;
                      lFormulas, lGridLines, lHeaders, lNoZero )

   METHOD SetPrinter( cHeader, cFooter, nLeft, nRight, nTop, nBottom, ;
                      lHeaders, lGredlines )

   //

   METHOD _Row( nRow, nHeight )
   METHOD _Col( nFirstCol, nLastCol, nWidth )

   //

   METHOD Blank( nRow, nCol, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   METHOD Number( nRow, nCol, nNumber, ;
                  lHidden, lLocked, nFont, nFormat, lShaded, ;
                  nBorder, nAlignament )

   METHOD String( nRow, nCol, cString, ;
                  lHidden, lLocked, nFont, nFormat, lShaded, ;
                  nBorder, nAlignament )

   METHOD _Date( nRow, nCol, dDate, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   METHOD Boolean( nRow, nCol, lBoolean, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

   METHOD Formula( nRow, nCol, nNumber, lRecalc, cFormula, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

   METHOD Say( nRow, nCol, uVal, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament )

   METHOD Error( nRow, nCol, nError, ;
                 lHidden, lLocked, nFont, nFormat, lShaded, ;
                 nBorder, nAlignament )

   //

   METHOD Note( nRow, nCol, cNote )

   METHOD AddBreak( cCourse, aPos )

   //

   METHOD PutCoors( nRow, nCol )

   METHOD PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                         nBorder, nAlignament, nReserved )
   //

   METHOD Info() INLINE MsgInfo( cInfo )

   METHOD Protec() INLINE nInfo := 0, ;
                          AEval( Array( len( cInfo ) ), ;
                          {| a, n | nInfo += Asc( SubStr( cInfo, n, 1 ) ) + n } ), ;
                          nInfo

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cFileName, lAutomatic, nIterations,;
            lProtect, lAutoexec, oWnd ) CLASS TFileXLS

   local n, nByte
   local nLen

   if ::Protec() != 4311
      MsgStop( "FileXLS Library" + CRLF + "Copyright violation !" )
      quit
   endif

   DEFAULT cFileName := cTempFile() + ".xls"

   ::cName = cFileName
   ::hFile = FCreate( cFileName, FC_NORMAL )

   ::lProtect  = lProtect
   ::lAutoexec = lAutoexec

   ::oWnd      = oWnd

   ::aHBreaks := {}
   ::aVBreaks := {}

   DEFAULT lAutomatic := .t., nIterations := 0

   FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )      // BOF
   FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 05 ) + Chr( 00 ) + Chr( 16 ) + Chr( 00 ), 4 )

   FWrite( ::hFile, Chr( 13 ) + Chr( 00 ), 2 )      // CALCMODE
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lAutomatic, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 12 ) + Chr( 00 ), 2 )      // CALCCOUNT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( if( nIterations != 0, nIterations, 1 ) ), 2 )

   FWrite( ::hFile, Chr( 15 ) + Chr( 00 ), 2 )      // REFMODE
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 17 ) + Chr( 00 ), 2 )      // ITERATION
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( nIterations != 0, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 16 ) + Chr( 00 ), 2 )      // DELTA
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )      // 0.001
   FWrite( ::hFile, D2Bin( 0.001 ), 8 )

   FWrite( ::hFile, Chr( 14 ) + Chr( 00 ), 2 )      // PRECISION
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // full
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 34 ) + Chr( 00 ), 2 )      // 1904
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // anything
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 37 ) + Chr( 00 ), 2 )      // DEFAULT ROW HEIGHT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // 33023
   FWrite( ::hFile, I2Bin( 33023 ), 2 )

   FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )                    // FONT 0
   FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 200 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 05 ), 1 )
   FWrite( ::hFile, "Arial", 5 )

   For n := 1 to 3
       if n > len( aFonts )
          FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )             // FONT
          FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 200 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, Chr( 05 ), 1 )
          FWrite( ::hFile, "Arial", 5 )
       else
          nByte := 0; nLen := len( aFonts[ n, XLSFONT_NAME ] )    // FONT n
          FWrite( ::hFile, Chr( 49 ) + Chr( 00 ), 2 )
          FWrite( ::hFile, I2Bin( 05 + nLen ), 2 )
          FWrite( ::hFile, I2Bin( aFonts[ n, XLSFONT_HEIGHT ] ), 2 )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_BOLD ], 1, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_ITALIC ], 2, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_UNDERLINE ], 4, 0 ) )
          nByte := nOR( nByte, if( aFonts[ n, XLSFONT_STRIKEOUT ], 8, 0 ) )
          FWrite( ::hFile, Chr( nByte ), 1 )
          FWrite( ::hFile, Chr( 00 ), 1 )
          FWrite( ::hFile, Chr( nLen ), 1 )
          FWrite( ::hFile, aFonts[ n, XLSFONT_NAME ], nLen )
         endif
   next

   FWrite( ::hFile, Chr( 64 ) + Chr( 00 ), 2 )      // BACKUP
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // not back up
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 31 ) + Chr( 00 ), 2 )      // FORMATCOUNT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )      // 1
   FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 30 ) + Chr( 00 ), 2 )      // FORMAT 0
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 07 ), 1 )
   FWrite( ::hFile, "General", 7 )

   For n := 1 to len( aFormats )
       nLen := len( aFormats[ n ] )
       FWrite( ::hFile, Chr( 30 ) + Chr( 00 ), 2 )  // FORMAT n
       FWrite( ::hFile, I2Bin( nLen + 1 ), 2 )
       FWrite( ::hFile, Chr( nLen ), 1 )
       FWrite( ::hFile, aFormats[ n ], nLen )
   next

return Self

//----------------------------------------------------------------------------//

METHOD End() CLASS TFileXLS

   local n
   local nLen

   local nReturn := 0

   nLen := Len( ::aHBreaks )                        // HORIZONTAL BREAK
   FWrite( ::hFile, Chr( 27 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( 02 + nLen * 2 ), 2 )
   FWrite( ::hFile, I2Bin( nLen ), 2 )
   for n := 1 to nLen
      FWrite( ::hFile, I2Bin( ::aHBreaks[ n ] - 1 ), 2 )
   next

   nLen := Len( ::aVBreaks )                        // VERTICAL BREAK
   FWrite( ::hFile, Chr( 26 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, I2Bin( 02 + nLen * 2 ), 2 )
   FWrite( ::hFile, I2Bin( nLen ), 2 )
   for n := 1 to nLen
      FWrite( ::hFile, I2Bin( ::aVBreaks[ n ] - 1 ), 2 )
   next

   FWrite( ::hFile, Chr( 18 ) + Chr( 00 ), 2 )      // PROTECT
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( ::lProtect, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 10 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

   FClose( ::hFile )
   ::hFile := 0

   if ::lAutoexec
      // WinExec( "start Excel " + ::cName, 0 )
      // nReturn := ShellExecute( 0, 'Open', ::cName,,, 2 )
      nReturn := ShellExecute( if( ::oWnd != nil, ::oWnd:hWnd, GetActiveWindow() ), ;
                               'Open', ::cName,,, 2 )
   endif

return nReturn

//----------------------------------------------------------------------------//
// Support functions for TFileXLS class

FUNCTION XLSFont( cName, nHeight, ;
                  lBold, lItalic, lUnderline, lStrikeout )
  local nFont

  DEFAULT cName := "Arial", nHeight := 10, ;
          lBold := .f., lItalic := .f., lUnderline := .f., lStrikeout := .f.

  nFont := AScan( aFonts, {|a| a[1] == nHeight * 20 .and. ;
                               a[2] == lBold .and. ;
                               a[3] == lItalic .and. ;
                               a[4] == lUnderline .and. ;
                               a[5] == lStrikeout .and. ;
                               a[6] == cName } )

  if nFont == 0
     AAdd( aFonts, { nHeight * 20, lBold, lItalic, lUnderline, lStrikeout, cName } )
     nFont := Len( aFonts )
  endif

return nFont

//

FUNCTION XLSFormat( cPicture )

  local nFormat

  DEFAULT cPicture := "0"

  nFormat := AScan( aFormats, cPicture )

  if nFormat == 0
     AAdd( aFormats, cPicture )
     nFormat := Len( aFormats )
  endif

return nFormat

//

FUNCTION XLSClsFont()
return( aFonts := {} )

//

FUNCTION XLSClsFormat()
return( aFormats := {} )

//----------------------------------------------------------------------------//

METHOD SetDisplay( nTop, nLeft, nBottom, nRight, lHidden, ;
                   lFormulas, lGridLines, lHeaders, lNoZero )

  DEFAULT nTop := 0, nLeft := 0, nBottom := 200, nRight := 300

  FWrite( ::hFile, Chr( 61 ) + Chr( 00 ), 2 )       // WINDOWS1
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nLeft * 20 ), 2 )
  FWrite( ::hFile, I2Bin( nTop * 20 ), 2 )
  FWrite( ::hFile, I2Bin( ( nRight - nLeft + 1 ) * 20 ), 2 )
  FWrite( ::hFile, I2Bin( ( nBottom - nTop + 1 ) * 20 ), 2 )
  FWrite( ::hFile, Chr( if( lHidden, 1, 0 ) ), 1 )

  FWrite( ::hFile, Chr( 62 ) + Chr( 00 ), 2 )       // WINDOWS2
  FWrite( ::hFile, Chr( 14 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( if( lFormulas, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( if( lGridLines, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( if( lHeaders, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( 00 ), 1 )
  FWrite( ::hFile, Chr( if( lNoZero, 0, 1 ) ), 1 )

  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, Chr( 01 ), 1 )
  FWrite( ::hFile, L2Bin( 00 ), 4 )

return nil

//----------------------------------------------------------------------------//

METHOD SetPrinter( cHeader, cFooter, nLeft, nRight, nTop, nBottom, ;
                   lHeaders, lGredlines ) CLASS TFileXLS

   local nLen

   DEFAULT cHeader := "", cFooter := "", ;
           nLeft := 0, nRight := 0, nTop := 0, nBottom := 0, ;
           lHeaders := .f., lGredlines := .f.

   nLen := Len( cHeader )                           // HEADER
   FWrite( ::hFile, Chr( 20 ) + Chr( 00 ), 2 )
   if nLen == 0
      FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   else
      FWrite( ::hFile, I2Bin( 01 + nLen ), 2 )
      FWrite( ::hFile, Chr( nLen ), 1 )
      FWrite( ::hFile, cHeader, nLen )
   endif

   nLen := Len( cFooter )                           // FOOTER
   FWrite( ::hFile, Chr( 21 ) + Chr( 00 ), 2 )
   if nLen == 0
      FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )
   else
      FWrite( ::hFile, I2Bin( 01 + nLen ), 2 )
      FWrite( ::hFile, Chr( nLen ), 1 )
      FWrite( ::hFile, cFooter, nLen )
   endif

   FWrite( ::hFile, Chr( 38 ) + Chr( 00 ), 2 )      // LEFT MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nLeft ), 8 )

   FWrite( ::hFile, Chr( 39 ) + Chr( 00 ), 2 )      // RIGHT MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nRight ), 8 )

   FWrite( ::hFile, Chr( 40 ) + Chr( 00 ), 2 )      // TOP MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nTop ), 8 )

   FWrite( ::hFile, Chr( 41 ) + Chr( 00 ), 2 )      // BOTTOM MARGIN
   FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, D2Bin( nBottom ), 8 )

   FWrite( ::hFile, Chr( 42 ) + Chr( 00 ), 2 )      // PRINT HEADERS
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lHeaders, 1, 0 ) ) + Chr( 00 ), 2 )

   FWrite( ::hFile, Chr( 43 ) + Chr( 00 ), 2 )      // PRINT GRIDLINES
   FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
   FWrite( ::hFile, Chr( if( lGredlines, 1, 0 ) ) + Chr( 00 ), 2 )

return nil

//----------------------------------------------------------------------------//

METHOD _Row( nRow, nHeight ) CLASS TFileXLS

  DEFAULT nHeight := 12.75

  FWrite( ::hFile, Chr( 08 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 16 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nRow - 1 ), 2 )

  FWrite( ::hFile, I2Bin( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 00 ), 2 )

  FWrite( ::hFile, I2Bin( nHeight * 20 ), 2 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( 00 ), 1 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( 00 ) + Chr( 00 ) + Chr( 00 ), 3 )

return nil

//----------------------------------------------------------------------------//

METHOD _Col( nFirstCol, nLastCol, nWidth, lHide )

  DEFAULT lHide := .f.
  DEFAULT nWidth := 10.71
  DEFAULT nLastCol := nFirstCol

  FWrite( ::hFile, Chr( 36 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )

  FWrite( ::hFile, Chr( nFirstCol - 1 ), 1 )
  FWrite( ::hFile, Chr( nLastCol - 1 ), 1 )

  if lHide
     FWrite( ::hFile, I2Bin( 0 ), 2 )
  else
     FWrite( ::hFile, I2Bin( Round( ( nWidth + 0.72 ) * 256, 0) ), 2 )
  endif

return nil

//----------------------------------------------------------------------------//

METHOD Blank( nRow, nCol, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 01 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 07 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

return nil

//----------------------------------------------------------------------------//

METHOD Number( nRow, nCol, nNumber, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament ) CLASS TFileXLS

  local lInteger := lInteger( nNumber )

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  if lInteger
     FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
     FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )
  else
     FWrite( ::hFile, Chr( 03 ) + Chr( 00 ), 2 )
     FWrite( ::hFile, Chr( 15 ) + Chr( 00 ), 2 )
  endif

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  if lInteger
     FWrite( ::hFile, I2Bin( nNumber ), 2 )
  else
     FWrite( ::hFile, D2Bin( nNumber ), 8 )
  endif

return nil

//----------------------------------------------------------------------------//

METHOD String( nRow, nCol, cString, ;
               lHidden, lLocked, nFont, nFormat, lShaded, ;
               nBorder, nAlignament ) CLASS TFileXLS

  local nLen := Len( cString )

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 04 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 08 + nLen ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( nLen ), 1 )
  FWrite( ::hFile, cString, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD _Date( nRow, nCol, dDate, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  local nDate

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 02 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament, 0 )

  nDate := dDate - CToD( "01/01/1900" ) + 2

  FWrite( ::hFile, I2Bin( nDate ), 2 )

return nil

//----------------------------------------------------------------------------//

METHOD Boolean( nRow, nCol, lBoolean, ;
                lHidden, lLocked, nFont, nFormat, lShaded, ;
                nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 05 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( if( lBoolean, 1, 0 ) ), 1 )
  FWrite( ::hFile, Chr( 00 ), 1 )

return nil

//----------------------------------------------------------------------------//

METHOD Formula( nRow, nCol, nNumber, lRecalc, cFormula, ;
                lHidden, lLocked, nFont, nFormat, lShaded, ;
                nBorder, nAlignament ) CLASS TFileXLS

  local cExpression := GetExpression( cFormula )
  local nLen := Len( cExpression )

  DEFAULT nNumber := 0, lRecalc := .t.

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 06 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 17 + nLen ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, D2Bin( nNumber ), 8 )

  FWrite( ::hFile, Chr( if( lRecalc, 2, 0 ) ), 1 )

  FWrite( ::hFile, Chr( nLen ), 1 )
  FWrite( ::hFile, cExpression, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD Say( nRow, nCol, uVal, ;
            lHidden, lLocked, nFont, nFormat, lShaded, ;
            nBorder, nAlignament ) CLASS TFileXLS

  local cType := ValType( uVal )

  if cType == "B"
     uVal := Eval( uVal )
     cType := ValType( uVal )
  endif

  do case
     case cType == "N"
          ::Number( nRow, nCol, uVal, ;
                    lHidden, lLocked, nFont, nFormat, lShaded, ;
                    nBorder, nAlignament )

     case cType == "C" .or. cType == "M"
          ::String( nRow, nCol, uVal, ;
                    lHidden, lLocked, nFont, nFormat, lShaded, ;
                    nBorder, nAlignament )

     case cType == "D"
          ::_Date( nRow, nCol, uVal, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

     case cType == "L"
          ::Boolean( nRow, nCol, uVal, ;
                     lHidden, lLocked, nFont, nFormat, lShaded, ;
                     nBorder, nAlignament )

     case cType == "U"
          ::Blank( nRow, nCol, ;
                   lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

     otherwise
          Eval( ErrorBlock(), _XLSGenError( DATATYPE_NOSUPPORT, ;
                                    CHR(13)+CHR(10) + "Type: " + cType ) )

  endcase

return nil

//----------------------------------------------------------------------------//

METHOD Error( nRow, nCol, nError, ;
              lHidden, lLocked, nFont, nFormat, lShaded, ;
              nBorder, nAlignament ) CLASS TFileXLS

  DEFAULT lHidden := .f., lLocked := .f., nFont := 0, nFormat := 0, lShaded := .f., ;
          nBorder := BORDER_NONE, nAlignament := ALING_NULL

  FWrite( ::hFile, Chr( 05 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, Chr( 09 ) + Chr( 00 ), 2 )

  ::PutCoors( nRow, nCol )
  ::PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                   nBorder, nAlignament )

  FWrite( ::hFile, Chr( nError ), 1 )
  FWrite( ::hFile, Chr( 01 ), 1 )

return nil

//----------------------------------------------------------------------------//

METHOD Note( nRow, nCol, cNote ) CLASS TFileXLS

  local nLen := Len( cNote )

  FWrite( ::hFile, Chr( 28 ) + Chr( 00 ), 2 )
  FWrite( ::hFile, I2Bin( 06 + nLen ), 2 )

  ::PutCoors( nRow, nCol )

  FWrite( ::hFile, I2Bin( nLen ), 2 )
  FWrite( ::hFile, cNote, nLen )

return nil

//----------------------------------------------------------------------------//

METHOD AddBreak( cCourse, aBreaks ) CLASS TFileXLS

  DEFAULT cCourse := "HORIZONTAL"

  do case
     case cCourse == "HORIZONTAL"
          AEval( aBreaks, {|nBreak| if( AScan( ::aHBreaks, nBreak ) == 0, ;
                                        AAdd( ::aHBreaks, nBreak ), ) } )
          ASort( ::aHBreaks )

     case cCourse == "VERTICAL"
          AEval( aBreaks, {|nBreak| if( AScan( ::aVBreaks, nBreak ) == 0, ;
                                        AAdd( ::aVBreaks, nBreak ), ) } )
          ASort( ::aVBreaks )

  endcase

return nil

//----------------------------------------------------------------------------//

METHOD PutCoors( nRow, nCol ) CLASS TFileXLS

  local cWord

  cWord := I2Bin( nRow - 1 )
  FWrite( ::hFile, @cWord, 2 ) //  Byte Offset 0-1

  cWord := I2Bin( nCol - 1 )
  FWrite( ::hFile, @cWord, 2 ) //  Byte Offset 2-3

return nil

//----------------------------------------------------------------------------//

METHOD PutAttributes( lHidden, lLocked, nFont, nFormat, lShaded, ;
                      nBorder, nAlignament, nReserved ) CLASS TFileXLS

  local nByte, cByte

  DEFAULT nReserved := 0

  nByte := 0
  if lHidden
     nByte := 128
  endif
  if lLocked
     nByte := nOR( nByte, 64 )
  endif
  nByte := nOR( nByte, nReserved )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 0

  if nFont == 0
     nByte := 0
  elseif nFont == 1
     nByte := 64
  elseif nFont == 2
     nByte := 128
  else
     nByte := 192
  endif
  nByte := nOR( nByte, nFormat )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 1

  nByte := 0
  if lShaded
     nByte := 128
  endif
  nByte := nOR( nByte, nBorder )
  nByte := nOR( nByte, nAlignament )

  cByte := Chr( nByte )
  FWrite( ::hFile, @cByte, 1 )  //  Byte Offset 3

return nil


//  Static functions
//----------------------------------------------------------------------------//

static function GetExpression( cFormula )

  local n, nLen

  local cExpression := ""
  local cLabel:= "", cNumber := "", cFunction := ""

  local cOperator := "", nPart, cChar, cSign := ""

  local lOperator := .f., lFunction := .f., lParenthetically := .f.

  local aBuffer := {}

  cFormula := StrTran( cFormula, " ", "" )
  nLen := Len( cFormula )

  n := 1

  do while n <= nLen

     cChar := Upper( SubStr( cFormula, n, 1 ) )

     do case

        case cChar $ "0123456789."
             if empty( cLabel )
                cNumber += cChar
             else
                cLabel += cChar
             endif

        case Asc( cChar ) >= 65 .and. Asc( cChar ) <= 90 ;
             .or. cChar == "_"
             cLabel += cChar

        case cChar $ "+-*/^"
             if lParenthetically .or. ;
                !empty( cNumber ) .or. !empty( cLabel ) .or. !empty( cfunction )

                if empty( cOperator )
                elseif ( cChar$"*/^" .and. cOperator$"+-" ).or. ;
                       ( cChar$"^" .and. cOperator$"*/" )
                       AAdd( aBuffer, cOperator )
                       cOperator := ""
                       lParenthetically := .f.
                elseif ( cChar$"+-" .and. cOperator$"*/^" ).or. ;
                       ( cChar$"*/" .and. cOperator$"^" )
                       lOperator := .t.
                endif

                if !empty( cNumber )
                   cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
                elseif !empty ( cLabel )
                   cExpression += GetNumber( &cLabel, cSign, cOperator )
                elseif !empty( cfunction )
                   cExpression += GetFunction( cFunction, cSign, cOperator )
                endif
                cNumber := cLabel := cFunction := ""

                if lParenthetically
                   if !empty( cOperator )
                      cExpression += Chr( AScan( aOperators, cOperator ) )
                   endif
                   lParenthetically := .f.
                endif

                if lOperator
                   do while len( aBuffer ) != 0 .and. Atail( aBuffer ) != "P"
                      if !empty( Atail( aBuffer ) )
                         cExpression += Chr( AScan( aOperators, Atail( aBuffer ) ) )
                      endif
                      ASize( aBuffer, len( aBuffer ) - 1 )
                   enddo
                   lOperator := .f.
                endif
                cOperator := cChar

                cSign := ""

             else

                cSign := cChar

             endif

        case cChar == "("
             if empty( cLabel )

                AAdd( aBuffer, cOperator )
                AAdd( aBuffer, "P" )
                cOperator := ""

             else

                #ifdef _MSLINK_
                lFunction := Upper( Left( clabel, 3 ) ) == "XLS"
                #else
                lFunction := Left( clabel, 1 ) == "_"
                #endif

                nPart := 1
                cLabel += "("
                do while nPart != 0
                   n++
                   cChar := SubStr( cFormula, n, 1 )
                   do case
                      case cChar == "("
                           nPart++
                      case cChar == ")"
                           nPart--
                      case lFunction .and. ;
                           cChar == "," .and. nPart = 1
                           cChar := ";"
                   endcase
                   cLabel += cChar
                enddo

                if lFunction
                   cFunction := cLabel
                   cLabel := ""
                else
                   cLabel := AllTrim( cValToChar( &cLabel ) )
                endif

             endif

        case cChar == ")"
             if !empty( cNumber )
                cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
             elseif !empty ( cLabel )
                cExpression += GetNumber( &cLabel, cSign, cOperator )
             elseif !empty( cfunction )
                cExpression += GetFunction( cFunction, cSign, cOperator )
             endif
             cNumber := cLabel := cFunction := ""

             if lParenthetically
                if !empty( cOperator )
                   cExpression += Chr( AScan( aOperators, cOperator ) )
                endif
                lParenthetically := .f.
             endif

             do while Atail( aBuffer ) != "P"
                if !empty( Atail( aBuffer ) )
                   cExpression += Chr( AScan( aOperators, Atail( aBuffer ) ) )
                endif
                ASize( aBuffer, len( aBuffer ) - 1 )
             enddo
             cExpression += Chr( 21 )
             ASize( aBuffer, len( aBuffer ) - 1 )
             cOperator := Atail( aBuffer )
             ASize( aBuffer, len( aBuffer ) - 1 )
             lParenthetically := .t.

        otherwise
             Eval( ErrorBlock(), _XLSGenError( SYNTATIC_ERROR, ;
                                      CHR(13)+CHR(10) + cChar ) )
      endcase

      n++

  enddo

  if !empty( cNumber )
     cExpression += GetNumber( Val( cNumber ), cSign, cOperator )
  elseif !empty( cLabel )
     cExpression += GetNumber( &cLabel, cSign, cOperator )
  elseif !empty( cfunction )
     cExpression += GetFunction( cFunction, cSign, cOperator )
  endif

  if lParenthetically
     if !empty( cOperator )
        cExpression += Chr( AScan( aOperators, cOperator ) )
     endif
     lParenthetically := .f.
  endif

  do while len( aBuffer ) != 0
     cOperator := Atail( aBuffer )
     if cOperator == "P"
        cExpression += Chr( 21 )
     else
        if !empty( cOperator )
           cExpression += Chr( AScan( aOperators, cOperator ) )
        endif
     endif
     ASize( aBuffer, len( aBuffer ) - 1 )
  enddo

return cExpression

//----------------------------------------------------------------------------//

Static function GetNumber( nNumber, cSign, cOperator )

  local cExpression := ""

  nNumber *= if( cSign == "-", -1, +1 )

  if lInteger( nNumber )
     cExpression += Chr( 30 )
     cExpression += I2Bin( nNumber )
  else
     cExpression += Chr( 31 )
     cExpression += D2Bin( nNumber )
  endif

  if !empty( cOperator )
     cExpression += Chr( AScan( aOperators, cOperator ) )
  endif

return cExpression

//----------------------------------------------------------------------------//

Static function GetFunction( cFunction, cSign, cOperator )

  local cExpression := ""
  local n, nType, cVal, nVal, nPar := 1, aPar := {}, aVal := {}, uVal

  local cName := Left( cFunction, At( "(", cFunction ) - 1 )
  local cParameters := SubStr( cFunction, At( "(", cFunction ) )

  cParameters := SubStr( cParameters, 2, len( cParameters ) - 2 )
  do while ( n := At( ";", SubStr( cParameters, nPar ) ) ) != 0
     cVal := SubStr( cParameters, nPar, n - 1 )
     AAdd( aPar, cVal )
     uVal := &cVal
     AAdd( aVal, uVal )
     nPar += n
  enddo
  if !empty( cParameters )
     cVal := SubStr( cParameters, nPar )
     AAdd( aPar, cVal )
     uVal := &cVal
     AAdd( aVal, uVal )
  endif

  do case

     //  Funct. Cell.

     #ifdef _MSLINK_
     case cName == "XLSCELL"
     #else
     case cName == "_CELL"
     #endif
          cExpression += Chr( 68 )
          nType := 192
          if len( aVal ) > 3 .and. aVal[ 4 ]
             nType -= 64
          endif
          if len( aVal ) > 2 .and. aVal[ 3 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )

     #ifdef _MSLINK_
     case cName == "XLSSUM"
     #else
     case cName == "_SUM"
     #endif
          cExpression += Chr( 37 )
          nType := 192
          if len( aVal ) > 5 .and. aVal[ 6 ]
             nType -= 64
          endif
          if len( aVal ) > 4 .and. aVal[ 5 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nType := 192
          if len( aVal ) > 7 .and. aVal[ 8 ]
             nType -= 64
          endif
          if len( aVal ) > 6 .and. aVal[ 7 ]
             nType -= 128
          endif
          nVal := aVal[ 3 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )
          nVal := aVal[ 4 ] - 1
          cExpression += Chr( nVal )
          cExpression += Chr( 25 ) + Chr( 16 ) + Chr( 00 )

     #ifdef _MSLINK_
     case cName == "XLSMULT"
     #else
     case cName == "_MULT"
     #endif
          cExpression += Chr( 37 )
          nType := 192
          if len( aVal ) > 5 .and. aVal[ 6 ]
             nType -= 64
          endif
          if len( aVal ) > 4 .and. aVal[ 5 ]
             nType -= 128
          endif
          nVal := aVal[ 1 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nType := 192
          if len( aVal ) > 7 .and. aVal[ 8 ]
             nType -= 64
          endif
          if len( aVal ) > 6 .and. aVal[ 7 ]
             nType -= 128
          endif
          nVal := aVal[ 3 ] - 1
          cExpression += Chr( nLoByte( nVal ) ) + Chr( nHiByte( nVal ) + nType )
          nVal := aVal[ 2 ] - 1
          cExpression += Chr( nVal )
          nVal := aVal[ 4 ] - 1
          cExpression += Chr( nVal )
          cExpression += Chr( 66 ) + Chr( 01 ) + Chr( 183 )

     // Funct. Math

     #ifdef _MSLINK_
     case cName == "XLSABS"
     #else
     case cName == "_ABS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 24 )

     #ifdef _MSLINK_
     case cName == "XLSINTE"
     #else
     case cName == "_INTE"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 25 )

     #ifdef _MSLINK_
     case cName == "XLSMOD"
     #else
     case cName == "_MOD"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += GetExpression( aPar[ 2 ] )
          cExpression += Chr( 65 ) + Chr( 39 )

     #ifdef _MSLINK_
     case cName == "XLSROUND"
     #else
     case cName == "_ROUND"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += GetExpression( aPar[ 2 ] )
          cExpression += Chr( 65 ) + Chr( 27 )

     #ifdef _MSLINK_
     case cName == "XLSSIGN"
     #else
     case cName == "_SIGN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 26 )

     #ifdef _MSLINK_
     case cName == "XLSSQRT"
     #else
     case cName == "_SQRT"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 20 )

     #ifdef _MSLINK_
     case cName == "XLSEXP"
     #else
     case cName == "_EXP"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 21 )

     #ifdef _MSLINK_
     case cName == "XLSLN"
     #else
     case cName == "_LN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 22 )

     #ifdef _MSLINK_
     case cName == "XLSLOG"
     #else
     case cName == "_LOG"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 23 )

     #ifdef _MSLINK_
     case cName == "XLSPI"
     #else
     case cName == "_PI"
     #endif
          cExpression += Chr( 65 ) + Chr( 19 )

     #ifdef _MSLINK_
     case cName == "XLSRANDOM"
     #else
     case cName == "_RANDOM"
     #endif
          cExpression += Chr( 65 ) + Chr( 63 )

     #ifdef _MSLINK_
     case cName == "XLSSIN"
     #else
     case cName == "_SIN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 15 )

     #ifdef _MSLINK_
     case cName == "XLSCOS"
     #else
     case cName == "_COS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 16 )

     #ifdef _MSLINK_
     case cName == "XLSTAN"
     #else
     case cName == "_TAN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 17 )

     #ifdef _MSLINK_
     case cName == "XLSASIN"
     #else
     case cName == "_ASIN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 98 )

     #ifdef _MSLINK_
     case cName == "XLSACOS"
     #else
     case cName == "_ACOS"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 99 )

     #ifdef _MSLINK_
     case cName == "XLSATAN"
     #else
     case cName == "_ATAN"
     #endif
          cExpression += GetExpression( aPar[ 1 ] )
          cExpression += Chr( 65 ) + Chr( 18 )

     otherwise
         Eval( ErrorBlock(), _XLSGenError( NODEFINED_FUNCTION, ;
                         CHR(13)+CHR(10) + "Function: " + cName ) )
  endcase

  if !empty( cSign )
     cExpression += Chr( AScan( aOperators, cSign ) + 15 )
  endif

  if !empty( cOperator )
     cExpression += Chr( AScan( aOperators, cOperator ) )
  endif

return cExpression

//----------------------------------------------------------------------------//

Static function lInteger( nNumber )
return nNumber <= 65535 .and. nNumber >= 0 .and. ;
     ( nNumber - INT( nNumber ) ) == 0


XLSError.prg
Code: Select all Collapse
// FileXLS automatic error generation

#include "Error.ch"
//#include "XLSError.ch"

external ProcName, ErrorSys

#define _SUBSYS_       "FileXLS"

#define ERR_MESSAGE    1
#define ERR_SEVERITY   2
#define ERR_SUBSYS     3
#define ERR_ERR_NO     4

//----------------------------------------------------------------------------//

FUNCTION _XLSGenError( nError, cOperation )

 local aErr := { { "Non defined XLS function", ES_CATASTROPHIC,, },;
                 { "Formula syntactic error", ES_CATASTROPHIC,, },;
                 { "Data type XLS no support", ES_WARNING,, } }

 local oError

 if nError > 0 .and. nError <= MAX_DEFINED_ERRORS

    oError = ErrorNew()

    oError:Severity    = aErr[ nError ][ ERR_SEVERITY ]
    oError:CanDefault  = oError:Severity < ES_CATASTROPHIC
    oError:SubSystem   = If( aErr[ nError ][ ERR_SUBSYS ] == nil,;
                        _SUBSYS_ ,;
                        aErr[ nError ][ ERR_SUBSYS ] )
    oError:SubCode     = If( aErr[ nError ][ ERR_ERR_NO ] == nil,;
                        nError,;
                        aErr[ nError ][ ERR_ERR_NO ] )
    oError:Description = aErr[ nError ][ ERR_MESSAGE ]
    oError:Operation   = cOperation

 endif

return oError


XLSFunc.prg
Code: Select all Collapse
// Compatibility XLS functions

//#define _MSLINK_

#ifdef _MSLINK_

// Funct. cells

function xlsCELL(); return 1

function xlsSUM(); return 1
function xlsMULT(); return 1

// Funct. Math.

function xlsABS(); return 1
function xlsINTE(); return 1
function xlsMOD(); return 1
function xlsROUND(); return 1
function xlsSIGN(); return 1

function xlsSQRT(); return 1
function xlsEXP(); return 1
function xlsLN(); return 1
function xlsLOG(); return 1

function xlsPI(); return 1
function xlsRANDOM(); return 1

function xlsSIN(); return 1
function xlsCOS(); return 1
function xlsTAN(); return 1
function xlsASIN(); return 1
function xlsACOS(); return 1
function xlsATAN(); return 1

#else

// Funct. cells

function _CELL(); return 1

function _SUM(); return 1
function _MULT(); return 1

// Funct. Math.

function _ABS(); return 1
function _INTE(); return 1
function _MOD(); return 1
function _ROUND(); return 1
function _SIGN(); return 1

function _SQRT(); return 1
function _EXP(); return 1
function _LN(); return 1
function _LOG(); return 1

function _PI(); return 1
function _RANDOM(); return 1

function _SIN(); return 1
function _COS(); return 1
function _TAN(); return 1
function _ASIN(); return 1
function _ACOS(); return 1
function _ATAN(); return 1

#endif
regards, saludos

Antonio Linares
www.fivetechsoft.com
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 09:03 AM

Mr.Antonio,

Muchas gracias.

Ramon Paredes,

驴Me puede dar una muestra PRG muestra el uso de la clase

Saludos

Anser

Ramon Paredes
Posts: 215
Joined: Fri Feb 02, 2007 03:38 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 03:14 PM

Anserkk :

Baja este archivo comprimido, ahi va ejemplo.prg donde te pongo dos ejemplos con filexls uno con un listado y uno con estadisticas y cuadros desde codigo, va ademas rgen1.dbf los datos de prueba y filexls.ch que no te lo habia proporcionado, el ejecutable que va ahi es el ejemplo compilado con fwh8.02 + xharboru 1.1., ojala te sea de utilidad

http://www.megaupload.com/es/?d=TQB41T0Z

Saludos desde Managua, Nicaragua

Ramon Paredes

... Desde la Tierra de lagos y Volcanes......
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Sat Feb 07, 2009 05:07 PM

Ramon Paredes,

Muchas gracias.

Anser

anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Mon Feb 09, 2009 11:17 AM
Dear Ramon Paredes,

Can you confirm that whether I need MS-Excel to be installed on the PC for the CLASS FileXLS to work ? In the sample which you have given I found that OLE "Excel.Application" is used, but in the CLASS FileXls I did not see any reference.

I am looking for a CLASS which can create .XLS file, even if MS-Excel is not installed on the PC running the FWH application
For Eg CLASS Txls but with more functionalities like your CLASS FileXLS. CLASS FileXLS has more fuctionalities in formatting and formulas
------------------------------------------
驴Puede usted confirmar que si necesito MS-Excel debe estar instalado en el PC para la CLASS FileXLS para trabajar? En la muestra que usted ha dado en mi opini贸n, OLE "Excel.Application" se utiliza, pero en la CLASS FileXls no vi ninguna referencia.

Estoy buscando una clase que puede crear. Archivo XLS, aunque MS-Excel no est谩 instalado en el PC que ejecuta la aplicaci贸n FWH
Por ejemplo, para la CLASS Txls pero con m谩s funcionalidades que su FileXLS CLASS. CLASS FileXLS tiene m谩s fuctionalities en formato y las f贸rmulas

Code: Select all Collapse
oExcel := TOleAuto():New( "Excel.Application" )
oHoja := oExcel:Get( "ActiveSheet" )

DEFINE XLS FORMAT nFormat1 PICTURE '#,##0' // para pesetas
DEFINE XLS FORMAT nFormat2 PICTURE '#,##0.00' // para euros

XLS oFileXLS FILE "MAESTRO1.XLS" //AUTOEXEC

Anser
Ramon Paredes
Posts: 215
Joined: Fri Feb 02, 2007 03:38 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Mon Feb 09, 2009 11:09 PM

anserkk :

Esta clase crea hoja xls sin necesidad de tener instalado excel, es una de las ventajas, ahora sus funcionalidades estan limitadas hasta donde su autor las dejo, nadie ha ampliado la misma, hasta donde tengo entendido, es muy agil para reportes que no demanden muchos retoques,

Slaudos desde Managua, Nicaragua

Ramon Paredes

... Desde la Tierra de lagos y Volcanes......
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Tue Feb 10, 2009 04:22 AM
Dear Ramon Paredes,

Esta clase crea hoja xls sin necesidad de tener instalado excel


Muchas gracias

Saludos

Anser
ManolinM2008
Posts: 4
Joined: Thu Jun 18, 2009 03:50 PM
Re: 驴C贸mo enviar a Excel reporte con TPrinter?
Posted: Fri Jun 19, 2009 12:02 AM

He encontrado una soluci贸n usando TPrinter para enviar directamente a Excel sin ir al previo
Usa TFileXls junto con estos programas. Sin embargo hay que adicionar en el reporte lo siguiente:

 If lExcel
    If lPrevio
       PRINT oPrn NAME cDoc PREVIEW SELECTION
    Else
       PRINT oPrn NAME cDoc
    Endif
 Else
    If lPrevio
       PRINT oPrn NAME cDoc PREVIEW
    Else
       PRINT oPrn NAME cDoc
    Endif
 Endif

Tambien es necesario agregar
If lExcel
Else
If nFil > 26.5
nFil := 1

Es Todo

// programa TMPRINTER

Include "FiveWin.ch"

include "FileXLS.ch"

Static oPrinter

CLASS TMPrinter FROM TPrinter

DATA lSalida AS LOGICAL INIT .T.
DATA bPreInit
DATA oSalida
DATA nRow
DATA nCol
Data cDoc
DATA lFin AS LOGICAL INIT .F.
//Redefiniendo Methods
METHOD New( cDoc, lUser, lPreview, cModel, lModal, lSelection ) CONSTRUCTOR
METHOD Activate()
METHOD CmSay( nCol, xText, nFont, nPad, nRow )
METHOD Stabilize()
METHOD End()
METHOD SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale )
METHOD Box( nRow, nCol, nBottom, nRight, nPen, nScale )
METHOD Line( nTop, nLeft, nBottom, nRight, nPen, nScale )
METHOD Shadow( nHeight )
METHOD Grid( nHeight, nRow, cChar )
METHOD Separator( nPen, nRow )

ENDCLASS

METHOD New( cDoc, lUser, lPreview, cModel, lModal, lSelection ) CLASS TMPrinter

Local uReturn // := Super:New( cDoc, lUser, lPreview,, lModal, lSelection )

PUBLIC lFin := .F.
PUBLIC nRow
DEFINE FONT oFont NAME "Arial" SIZE 0,-11

If ::lSalida // := .T.
cDocumento := cDoc
::oSalida := TSalPrinterXls():New( Self, AllTrim( Left( cDocumento, 8 ) ) + '.xls' )
Else
uReturn := Super:New( cDoc, lUser, lPreview,, lModal, lSelection )
Endif

Return Self

METHOD Activate() CLASS TMPrinter

Local oPagina
Local hActWnd := GetActiveWindow()

::hOldRes := GetResources()

#ifdef CLIPPER
SET RESOURCES TO "preview.dll"
#else
SET RESOURCES TO "prev32.dll"
#endif

If GetResources() < 32
#ifdef CLIPPER
MsgStop( "Preview.dll not found", "Error" )
#else
MsgStop( "Prev32.dll not found", "Error" )
#endif
SetResources(::hOldRes)
RETU NIL
EndIf
// Estabilizar el listado
IF !::lCreated
::End()
RETU NIL
ENDIF
::Stabilize()
IF !::lStable
::End()
RETURN NIL
ENDIF

Return Nil

METHOD CmSay( nRow, nCol, xText, oFont, nWidth, nClrText, nBkMode, nPad ) CLASS TMPrinter

Local cPicture1 := "@!", cPicture2 := "@99,999,999.99", nFont := oFont:nHeight

If ::lSalida
nRow := Int( Round( ( nRow * 10 / 3)+0.5, 1 ) )
nCol := Int( Round(nCol+0.5,1) ) // Int( Round( ( nCol * 125 / 25.5 )+0.5,1 ))
nRow2 := nRow
// MsgInfo(Str(nRow)+"<<>>"+Str(nCol))
::oSalida:Say( nCol, xText, nFont, nPad, nRow, cPicture1 )
Else
If ValType( xText ) == 'N' .and. !Empty( cPicture2 )
xText:= Transform( xText, cPicture2 )
EndIf
Super:CmSay( nRow, nCol, xText, oFont, nWidth, nClrText, nBkMode, nPad )
EndIf

Return Nil

METHOD Stabilize() CLASS TMPrinter

If ::lSalida
::oSalida:Stabilize()
Else
Super:Stabilize()
EndIf

Return Nil

METHOD End() CLASS TMPrinter

 If ::lSalida
    ::oSalida:Save()
 Else
 Endif

Return Nil

METHOD SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:SayBitmap( nRow, nCol, cBitmap, nWidth, nHeight, nScale )
EndIf

Return Nil

METHOD Box( nRow, nCol, nBottom, nRight, nPen, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Box( nRow, nCol, nBottom, nRight, nPen, nScale )
EndIf

Return Nil

METHOD Line( nTop, nLeft, nBottom, nRight, nPen, nScale ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Line( nTop, nLeft, nBottom, nRight, nPen, nScale )
EndIf

Return Nil

METHOD Shadow( nHeight ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Shadow( nHeight )
EndIf

Return Nil

METHOD Grid( nHeight, nRow, cChar ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Grid( nHeight, nRow, cChar )
EndIf

Return Nil

METHOD Separator( nPen, nRow ) CLASS TMPrinter

If ::lSalida
//
Else
Super:Separator(nPen, nRow)
EndIf

Return Nil

Function PrintBegin( cDoc, lUser, lPreview, xModel, lModal, lSelection )

 local aPrn
 local cText, cDevice
 local nScan
 PUBLIC lSalid2

 lSalid2 := lSelection
 If lSelection
    if xModel == nil
       return oPrinter := TMPrinter():New( cDoc, lUser, lPreview,, lModal, lSelection )
    endif
    cText := StrTran( GetProfString( &quot;Devices&quot; ),Chr(0), chr(13)+chr(10))
    aPrn  := Array( Mlcount( cText, 250 ) )
    Aeval(aPrn, {|v,e| aPrn[e] := Trim(Memoline(cText, 250, e)) } )
    if Valtype(xModel) == &quot;N&quot;
       if xModel &lt; 0 .or. xModel &gt; len(aPrn)
          nScan := 0
       else
          nScan := xModel
       endif
    else
       if ( nScan := Ascan( aPrn, {|v| Upper( xModel ) == Upper( v ) } ) ) == 0
          nScan = Ascan( aPrn, {|v| Upper( xModel ) $ Upper( v ) } )
       endif
    endif
    if nScan == 0
       MsgBeep()
       return oPrinter := TMPrinter():New( cDoc, .T., lPreview,, lModal, lSelection )
    endif
    cText   := GetProfString( &quot;Devices&quot;, aPrn[ nScan ] )
    cDevice := aPrn[ nScan ] + &quot;,&quot; + cText
 Else
    if xModel == nil
       return oPrinter := TPrinter():New( cDoc, lUser, lPreview,, lModal, lSelection )
    endif
    cText := StrTran( GetProfString( &quot;Devices&quot; ),Chr(0), chr(13)+chr(10))
    aPrn  := Array( Mlcount( cText, 250 ) )
    Aeval(aPrn, {|v,e| aPrn[e] := Trim(Memoline(cText, 250, e)) } )
    if Valtype(xModel) == &quot;N&quot;
       if xModel &lt; 0 .or. xModel &gt; len(aPrn)
          nScan := 0
       else
          nScan := xModel
       endif
    else
       if ( nScan := Ascan( aPrn, {|v| Upper( xModel ) == Upper( v ) } ) ) == 0
          nScan = Ascan( aPrn, {|v| Upper( xModel ) $ Upper( v ) } )
       endif
    endif
    if nScan == 0
       MsgBeep()
       return oPrinter := TPrinter():New( cDoc, .T., lPreview,, lModal, lSelection )
    endif
    cText   := GetProfString( &quot;Devices&quot;, aPrn[ nScan ] )
    cDevice := aPrn[ nScan ] + &quot;,&quot; + cText
 Endif

Return If(lSelection,oPrinter := TMPrinter():New( cDoc, .f., lPreview, cDevice, lModal, lSelection ),oPrinter := TPrinter():New( cDoc, .f., lPreview, cDevice, lModal, lSelection ))

Function PageBegin()

 If lSalid2
    //
 Else
    oPrinter:StartPage()
 Endif

Return nil

Function PageEnd()

 If lSalid2
    // nRow debe continuar incrementandose
 Else
    oPrinter:EndPage()
 Endif

Return nil

Function PrintEnd()

 If lSalid2
    oPrinter:End() // hay error al ejecutar esta opci贸n.
 Else
    if oPrinter:lMeta
       oPrinter:Preview()
    else
       oPrinter:End()
    Endif
    oPrinter := nil
 Endif

Return nil

// TSalPrinter

include "FileXLS.ch"

include "FiveWin.ch"

include "Report.ch"

CLASS TSalPrinterXLS

DATA oPrn
DATA oXls
DATA cFile
DATA aFont
DATA aFormat

DATA nRow

METHOD New( ) CONSTRUCTOR
METHOD Save()
// METHOD StartPage()
// METHOD EndPage()
METHOD Stabilize()
METHOD Say( nCol, xText, nFont, nPad, nRow, cPicture )

ENDCLASS

METHOD New( oPrn, cFile ) CLASS TSalPrinterXLS

DEFAULT cFile:= "MyFile.xls"

::aFont := {}
::aFormat:= {}
::cFile := cFile
::oPrn := oPrn
::nRow := 0
::oXls := TFileXLS():New( ::cFile, , , .F., .T. )
// cFileName,lAutomatic,nIterations,lProtect,lAutoexec,oWnd
Return Self

METHOD Save() CLASS TSalPrinterXLS

MsgRun( "Generando Arquivo Excel.... espere ", , {|| ::Stabilize() } )

SET XLS TO DISPLAY ;
OF ::oXLS

::oXLS:End()

RETURN Self

METHOD Stabilize() CLASS TSalPrinterXLS

RETURN Nil

METHOD Say( nCol, xText, nFont, nPad, nRow, cPicture ) CLASS TSalPrinterXLS

LOCAL uVal, ;
nAlignamen := 0, ;
nFormat := 0

DEFAULT xText := '', ;
nFont := 1, ;
nPad := RPT_LEFT

// nFont:= ::cFont( nFont )

DO CASE
CASE nPad == RPT_LEFT
nAlignament := ALING_LEFT

  CASE nPad == RPT_RIGHT
       nAlignament := ALING_RIGHT

  CASE nPad == RPT_CENTER
       nAlignament := ALING_CENTER

ENDCASE

// IF !empty( cPicture )
// nFormat := 0 // ::cFormat( cPicture, valtype( xText ) )
// ENDIF
LineadeStatus(Str(nRow)+"--"+str(nCol)+"->"+Alltrim(xText)+Str(nFont),4)
@ nRow, nCol XLS SAY xText OF ::oXLS ;
FONT nFont ; // FORMAT nFormat ;
ALIGNAMENT nAlignament

Return Nil

Es todo

Manuel J. Morales Q.
Lima Per煤

Continue the discussion

Static archive 路 New replies & topics via GitHub Discussions